{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Author:       Angus Robertson, Magenta Systems Ltd
Description:  OAuth2 and OAuth1A authentication, and components to send cloud
              email and Tweets, all using the TSslHttpRest component.
Creation:     March 2022
Updated:      Aug 2023
Version:      V9.0
EMail:        francois.piette@overbyte.be  http://www.overbyte.be
Support:      https://en.delphipraxis.net/forum/37-ics-internet-component-suite/
Legal issues: Copyright (C) 2023 by Angus Robertson, Magenta Systems Ltd,
              Croydon, England. delphi@magsys.co.uk, https://www.magsys.co.uk/delphi/

              This software is provided 'as-is', without any express or
              implied warranty.  In no event will the author be held liable
              for any  damages arising from the use of this software.

              Permission is granted to anyone to use this software for any
              purpose, including commercial applications, and to alter it
              and redistribute it freely, subject to the following
              restrictions:

              1. The origin of this software must not be misrepresented,
                 you must not claim that you wrote the original software.
                 If you use this software in a product, an acknowledgment
                 in the product documentation would be appreciated but is
                 not required.

              2. Altered source versions must be plainly marked as such, and
                 must not be misrepresented as being the original software.

              3. This notice may not be removed or altered from any source
                 distribution.

              4. You must register this software by sending a picture postcard
                 to the author. Use a nice stamp and mention your name, street
                 address, EMail address and any comment you like to say.



Overview
--------

TSimpleWebSrv
-------------
This is a simple web server primarily designed for accepting HTTP and HTTPS requests
from REST servers which don't expect real pages to be sent, but also for .well-known
responses generated by applications.  Allows listening on multiple IPs and ports.


TRestOAuth
----------
This for handling 0Auth authorization to web apps, by several means.  Beware
OAuth is really a concept with differing implementations, so that implementation
may not always be straight forward.  OAuth1 and 1A were originally developed for
Twitter and use cryptography, OAuth2 is a simpler and easier to implement version
now widely used by most cloud services without any cryptography (other than SSL).

The conceptual issue about OAuth is that applications should not know any login
details.  The login need to be entered through a browser, which then redirects to
a fixed URL which includes an Authorization Code that is subsequently exchanged
for an Access Token that can used by the REST client.  Note that Authorization
Codes expire in a few minutes and are immediately exchanged for an Access Token.
This is really all designed for interactive applications, on mobile platforms
in particular. The Access Token is then sent with all HTTPS REST requests as
an 'Authorization: Bearer' header.

Access Tokens often have a limited life and may expire within one to 24 hours.
To avoid user interaction, the token exchange process usually offers a Refresh
Token which can be used to get another Access Token, and this is automatically
handled by TRestOAuth, by refreshing the Access Token before it expires, allowing
your application to keep running.  Store the Refresh Token securely as if it were
a password, since it's a potential security risk, it can be easily cancelled if
compromised.

Sometimes the Refresh Token has the same life as the Access Token, with Google
Accounts the Refresh Token remains valid for a few months until the account is
disabled or changed, avoiding needing to login again or refresh within the expiry
period.  Beware with Google the Refresh Token is only returned once after initial
login, not after each refresh.  Google may also need to approve applications
offering OAuth2, and may show consent warnings during the login process to get
an Authorization Code until this is done.
https://developers.google.com/identity/protocols/OAuth2

Setting up OAuth is complex and requires a lot more information than just a site
user name and password.  You normally need to access the desired site and create
an app or client (terminology varies) but will always involve creating a client
ID and client secret, and a redirect URL which will be the local web server.  The
default redirect used by TRestOAuth is http:/localhost:8080/.  There are also
two API URLs, one for the authorization endpoint (displayed in the browser) and
then the token exchange endpoint for REST requests.  Some sites may provide OAuth2
details with the URL (host)/.well-known/openid-configuration as Json, ie:
https://accounts.google.com/.well-known/openid-configuration .   Finally, OAuth
may require the token Scope to be specified, it's purpose or access rights
depending on the server. This component includes TOAuthUri records that are
designed to set-up common OAuth2 account settings for Google, Microsoft and
other end points.

Note that in addition to granting tokens using an Authorization Code from a
browser login, some OAuth implementations may support grants for client
credentials alone (ID and secret, without a login) or directly for login and
password (and client ID and secret) which is by far the easiest to use, but not
often available, both are supported by TRestOAuth.


Embedded or Standard Browser
----------------------------

Originally it was considered allowable for native applications to display an
embedded browser window in the application to capture the Authorization Code
during redirect.  But that potentially means the application can also capture the
login as well so is no longer best practice, see RFC8252, and some apps will
block the embedded window.  The preferred authorization method is for the native
application to launch the standard browser and redirect to localhost where a
small web server runs to capture the Authorization Code.

TRestOAuth supports both embedded and standard browsers, the embedded browser gives
a better user experience with the windows closing automatically once authentication
is complete and not needing a local web server, but may not be supported by Windows
or end points. Launching a web page into the standard browser may replace a page
being viewed, there may be firewall or other problems connecting to the localhost
web server and the browser window remains open upon completion.  So the end user
should ideally be given a choice of which browser to use.

ICS includes TOAuthLoginForm which displays browser pages to handle OAuth login.
It supports two browser engines with Delphi 10.4 and later, TEdgeBrowser Chromium
based browser introduced in 2020 for Windows 10 and 11 which should be on most
recent PCs provided Windows Update is used, and the older TWebBrowser using
Microsoft's Shell Doc Object and Control Library (SHDOCVW.DLL), part of Internet
Explorer, which is removed when Edge is installed, but still seems to be available,
and is used on older Windows versions.  Edge Chromium can be installed on Windows
7 and later. The form checks for Edge in the registry and for the WebView2Loader.dll,
otherwise uses TWebBrowser.

Note Google no longer supports authentication using TWebBrowser, you will get
script errors and a warning to use another browser, and announced it would no
longer support embedded browsers at all, but a year later Edge still seems to work:
https://developers.googleblog.com/2021/06/upcoming-security-changes-to-googles-oauth-2.0-authorization-endpoint.html

Officially the Microsoft.Web.WebView2 runtime  (from GetIt) must be installed for
Edge Chromium to work, but in practice copying WebView2Loader.dll into the same
directory as the executable seems to work, there are Win32 and Win64 versions of
this DLL with the same name, you need the correct version for the build!


Google and Microsoft OAuth2 Email Application Accounts
------------------------------------------------------
To access email using REST APIs or OAuth2/SMTP/POP3 an 'application account'
needs to be created though the provider console. This is generally done once
by the developer and the application API ID and secret are then distributed
with the application (usually hidden). These are then used by OAuth2 when
logging in with an end user account.  Note end users don't need to access
the provider console or know it exists.

For Google, the console is https://console.developers.google.com/. Go to
Credentials, Create New Credentials, Create OAuth client ID, Web Application,
name the application something like GMailApp, generate the Client Id and Client
Secret, set the Authorised redirect URI to http://localhost:8080/gmail/  and
enable the Gmail API for your account.  All this information enables the
application using this component to access Gmail, once it has also logged
into a Gmail user account usually different to the application account.  The
user account password is unknown to the application, the login process returns
temporary tokens that are used instead of a password.  During the login process
the end user will be asked to give access to the application, which is why the
name must be recognisable.  Google may also need to test your final application
to avoid warnings.

For Microsoft, termininology is more complicated, the console is Microsoft Azure,
https://portal.azure.com/#blade/Microsoft_AAD_RegisteredApps/ApplicationsListBlade
while email is called Microsoft Outlook or Office 365 with the APIs called Micosoft
Graph. Permissions and scopes are horrible, still not sure I understand them.
In the Azure console, take App Registrations, New Registration, app name something
like OutLookEmail, redirect URI is http://localhost:8080/microsoft/.  Microsoft
also has User Authorities for different types of accounts, defaults to 'consumers'
for Live mail atc, but can be changed to 'common' or an Azure Active Directory
tenant GUID for corporate accounts. Keep the Application (Client) ID offered,
take Certificate & secrets, create client secret and keep that as well, expires
never.  Other settings are needed to allow Microsoft to authenticate your final
application. Supported account types should include Multitenant for Office 365,
otherwse just consumer accounts.  API permissions should be set to read and
write Mail, SMTP and POP, also profile.

With Google, you can not specify which account the users logs into using the
browser, but after login the component retrieves the email acount name in NewEmail.
With Microsoft, you can provide a user name hint that should cause the browser
to offer that name, but the component can only retrieve the email account
using the claim 'profile' which does not seem to work with SMTP/POP3 claims.

After an OAuth2 browser login, you must save the Refresh Token securely since
it is effectively a password to access the user account from this application
account for months from multiple devices.  For unattended applications or
services, the Refresh Token may be copied from another device, beware the token
may finally expire after several months or be cancelled, and will need a fresh
login for a new Refresh Token.

The Access Token need not be saved, for Google and Microsoft it expires after
one hour and will be automatically updated using the Refresh Token.

To simplify loading OAuth2 settings, there is a function IcsLoadRestEmailFromIni
that loads from section RestEmail as follows:

{ default INI section
[RestEmail]
RestEmailType=RestEmailGoogle
ClientId=
ClientSecret=
RefrToken=
MsUserAuth=consumers
OAEdgeCacheDir=

You need to add your specific account settings to the INI file, ideally you
should replaced this function with one that encrypts these settings since
they are private to the developer.


Updates:
May 26, 2022 - V8.69 - baseline, split from OverbyteIcsSslHttpRest.pas unit, moved
                       TRestOAuth, TSimpleWebSrv, TIcsTwitter and TIcsRestEmail
                       components here to ease maintenance and use.
Oct 25, 2022 - V8.70 - Added IcsLoadRestEmailFromIni to load TIcsRestEmail secrets
                         and tokens from INI file. Ideally these settings should
                         be encrypted!!
                       Added OAuth2 MsUserAuthority and RestEmail MsUserAuth properties
                         to access different Microsoft User Authorities, defaults to
                         consumers but can be changed to common or an Azure Active
                         Directory tenant GUID for corporate accounts.  Note this
                         requires supported account types include Multitenant.
                       Log expected RedirectUrl so user can check it's configured
                         correctly in console.
Jul 19, 2022 - V8.71 - Support TRestOAuth authentication OAuthTypeEmbed (embedded browser) using
                         new TOAuthBrowser component and TOAuthLoginForm window, that uses
                         TEdgeBrowser or TWebBrowser to display web page without needing
                         external browser or web server, traps redirect request to get
                         authentication code, Edge is Delphi  10.4 or later only.
                       To use the embedded browser, drop a TOAuthBrowser component on the form
                         and call it from the TRestOAuth FOnOAuthEmbed or TIcsRestEmail
                         FOnOAEmbed properties (see REST sample).
                       Added TRestOAuth EdgeCacheDir property to specify a working directory for
                         Edge to cache file, if left blank uses the system work directory.
                       The TRestOAuth and TIcsTwitter StartAuthorization functions now have an
                         optional Sender parameter that may be set to the form calling it which
                         is passed to the TOAuthLoginForm window, also the TIcsRestEmail
                         GetNewToken function.
                       Note TRestOAuth the LoginHint property is passed to the TOAuthLoginForm
                         window, displayed and copied to the clipboard so it may be pasted into
                         the login account field. For Google, it should appear automatically.
                         For TIcsRestEmail, set the AccountHint property instead.
                       Don't URL encode OAuth grant_types, some servers don't like that.
                       Log the parameters passed to OAuth grant requests.
                       Using Int64 ticks.
Aug 08, 2023 V9.0  Updated version to major release 9.


        pending - login to Twitter fails due to no posted data, but sending tweets works with token..


Note - FMX applications require the FMX conditional to ensure the correct OAuth form is linked.



Pending - more documentation
Pending - OAuth don't spawn browser from Windows service
}

{$IFNDEF ICS_INCLUDE_MODE}
unit Z.ICS9.OverbyteIcsSslHttpOAuth;
{$ENDIF}

{$I Include\Z.ICS9.OverbyteIcsDefs.inc}

{$IFDEF COMPILER14_UP}
  {$IFDEF NO_EXTENDED_RTTI}
    {$RTTI EXPLICIT METHODS([]) FIELDS([]) PROPERTIES([])}
  {$ENDIF}
{$ENDIF}
{$B-}             { Enable partial boolean evaluation   }
{$T-}             { Untyped pointers                    }
{$X+}             { Enable extended syntax              }
{$H+}             { Use long strings                    }
{$IFDEF BCB}
    {$ObjExportAll On}
{$ENDIF}

interface

{$IFDEF USE_SSL}

uses
{$IFDEF MSWINDOWS}
    {$IFDEF RTL_NAMESPACES}Winapi.Messages{$ELSE}Messages{$ENDIF},
    {$IFDEF RTL_NAMESPACES}Winapi.Windows{$ELSE}Windows{$ENDIF},
    {$IFDEF RTL_NAMESPACES}Winapi.ShellAPI{$ELSE}ShellAPI{$ENDIF},
    {$IFDEF RTL_NAMESPACES}System.IniFiles{$ELSE}IniFiles{$ENDIF},   { V8.70 }
    {$IFDEF COMPILER16_UP}System.IOUtils,{$ENDIF}                    { V8.71 }
{$ENDIF}
{$IFDEF POSIX}
    Posix.Time,
    System.IOUtils,           { V8.69 }
    System.IniFiles,          { V8.70 }
    Z.ICS9.Ics.Posix.WinTypes,
    Z.ICS9.Ics.Posix.PXMessages,
{$ENDIF}
    {$IFDEF RTL_NAMESPACES}System.Classes{$ELSE}Classes{$ENDIF},
    {$IFDEF RTL_NAMESPACES}System.Sysutils{$ELSE}Sysutils{$ENDIF},
    {$IFDEF RTL_NAMESPACES}System.TypInfo{$ELSE}TypInfo{$ENDIF},
    {$IFDEF RTL_NAMESPACES}System.UITypes, System.UIConsts,{$ENDIF}     { V8.69 }
    Z.ICS9.OverbyteIcsSSLEAY, Z.ICS9.OverbyteIcsLIBEAY,
{$IFDEF YuOpenSSL}YuOpenSSL,{$ENDIF YuOpenSSL}
    Z.ICS9.OverbyteIcsWinsock,
    Z.ICS9.OverbyteIcsTypes,
    Z.ICS9.OverbyteIcsUtils,
    Z.ICS9.OverbyteIcsUrl,
{$IFDEF FMX}
    Z.ICS9.Ics.Fmx.OverbyteIcsWndControl,
    Z.ICS9.Ics.Fmx.OverbyteIcsWSocket,
    Z.ICS9.Ics.Fmx.OverbyteIcsWSocketS,
    Z.ICS9.Ics.Fmx.OverbyteIcsHttpProt,
    Z.ICS9.Ics.Fmx.OverbyteIcsSslHttpRest,
    Z.ICS9.Ics.Fmx.OverbyteIcsSslJose,
{$ELSE}
    Z.ICS9.OverbyteIcsWndControl,
    Z.ICS9.OverbyteIcsWSocket,
    Z.ICS9.OverbyteIcsWSocketS,
    Z.ICS9.OverbyteIcsHttpProt,
    Z.ICS9.OverbyteIcsSslHttpRest,
    Z.ICS9.OverbyteIcsSslJose,
{$ENDIF FMX}
    Z.ICS9.OverbyteIcsLogger,         { for TLogOption }
    Z.ICS9.OverbyteIcsFormDataDecoder,
    Z.ICS9.OverbyteIcsSuperObject,
    Z.ICS9.OverbyteIcsTicks64,
    Z.ICS9.OverbyteIcsStreams;   { V8.68 }

{ NOTE - these components only build with SSL, there is no non-SSL option }

const
    THttpOAuthVersion = 900;
    CopyRight : String = ' TSslHttpOAuth (c) 2023 F. Piette V9.0 ';
    TestState = 'Testing-Redirect';
    MimeAppCert = 'application/pkix-cert';          { V8.69 }

    OAuthErrBase                     = {$IFDEF MSWINDOWS} 1 {$ELSE} 1061 {$ENDIF};
    OAuthErrNoError                  = 0;
    OAuthErrParams                   = OAuthErrBase;
    OAuthErrBadGrant                 = OAuthErrBase+1;
    OAuthErrWebSrv                   = OAuthErrBase+2;
    OAuthErrBrowser                  = OAuthErrBase+3;
    OAuthErrEvent                    = OAuthErrBase+4;     { V8.65 }
    OAuthErrCancelled                = OAuthErrBase+5;     { V8.71 }

type
{ event handlers }
  TSimpleWebSrvReqEvent = procedure (Sender: TObject; const Host, Path, Params: string; var RespCode, Body: string) of object;
  TOAuthAuthUrlEvent = procedure (Sender: TObject; const URL: string) of object;
  TOAuthEmbedBrowEvent = procedure (Sender: TObject; const URL: string; var Success: Boolean) of object;  { V8.71 }

{ property and state types }
  TOAuthProto = (OAuthv1, OAuthv1A, OAuthv2);
  TOAuthType = (OAuthTypeWeb, OAuthTypeMan, OAuthTypeEmbed);
  TOAuthOption = (OAopAuthNoRedir,    { OAuth Auth Request do not send redirect_url }
                  OAopAuthNoScope,    { OAuth Auth Request do not send scope }
                  OAopAuthNoState,    { OAuth Auth Request do not send state }
                  OAopAuthPrompt,     { OAuth Auth Request send approval prompt V8.63 }
                  OAopAuthAccess,     { OAuth Auth Request send access type V8.63 }
                  OAopAuthGrantedScope, { OAuth Auth include granted scope V8.65 Google }
                  OAopAuthRespMode,   { OAuth Auth Request send resp_mode V8.65  Microsoft }
                  OAopAuthLoginHint); { OAuth Auth Request send resp_mode V8.65 Microsoft }
  TOAuthOptions = set of TOAuthOption;


{ TSimpleWebSrv is a simple web server primarily designed for accepting
   requests from REST servers which don't expect real pages to be sent }

type
{ forware declaration for TSimpleClientSocket }
  TSimpleWebSrv = class;

  TSimpleClientSocket = class(TSslWSocketClient)
  private
    { Private declarations }
  public
    { Public declarations }
    WebSrv: TSimpleWebSrv;
    RecvBuffer: TBytes;
    RecvWaitTot: Integer; // current data in RecvBuffer
    RecvBufMax: Integer;  // buffer size
    HttpReqHdr: String;
    OnSimpWebSrvReq: TSimpleWebSrvReqEvent;
{ following are parsed from HTTP request header }
    RequestMethod: THttpRequest;        // HTTP request header field
    RequestContentLength: Int64;        // HTTP request header field
    RequestHost: String;                // HTTP request header field
    RequestHostName: String;            // HTTP request header field
    RequestHostPort: String;            // HTTP request header field
    RequestPath: String;                // HTTP request header field
    RequestParams: String;              // HTTP request header field
    RequestReferer: String;             // HTTP request header field
    RequestUserAgent: String;           // HTTP request header field
    procedure CliSendPage(const Status, ContentType, ExtraHdr, BodyStr: String);
    procedure CliErrorResponse(const RespStatus, Msg: string);
    procedure CliDataAvailable(Sender: TObject; Error: Word);
    procedure ParseReqHdr;
  end;

  TSimpleWebSrv = class(TIcsWndControl)
  private
    { Private declarations }
    FDebugLevel: THttpDebugLevel;
    FWebSrvIP: string;
    FWebSrvIP2: string;          { V8.65 might need I{v6 as well }
    FWebSrvPort: string;
    FWebSrvPortSsl: string;
    FWebSrvCertBundle: string;   { following V8.62 for SSL }
    FWebSrvCertPassword: string;
    FWebSrvHostName: string;
    FWebSrvRootFile: string;
    FWebServer: TSslWSocketServer;
    FOnServerProg: THttpRestProgEvent;
    FOnSimpWebSrvReq: TSimpleWebSrvReqEvent;
    FOnSimpWebSrvAlpn: TClientAlpnChallgEvent;
  protected
    { Protected declarations }
    procedure LogEvent(const Msg : String);
    procedure SocketBgException(Sender: TObject;
                          E: Exception; var CanClose: Boolean);
    procedure ServerClientConnect(Sender: TObject; Client: TWSocketClient; Error: Word); virtual;
    procedure ServerClientDisconnect(Sender: TObject;
                                 Client: TWSocketClient; Error: Word);
    procedure IcsLogEvent (Sender: TObject; LogOption: TLogOption; const Msg : String);
  public
    { Public declarations }
{$IFNDEF NO_DEBUG_LOG}
    SrvLogger:  TIcsLogger;
{$ENDIF}
    property WebServer: TSslWSocketServer           read  FWebServer
                                                    write FWebServer;  { V8.64 }
    constructor  Create (Aowner: TComponent); override;
    destructor   Destroy; override;
    function  StartSrv: boolean ;
    function  StopSrv(CloseClients: Boolean = True): boolean ;                  { V8.65 }
    function  IsRunning: Boolean;
    function  ListenStates: String;
  published
    { Published declarations }
    property DebugLevel: THttpDebugLevel            read  FDebugLevel
                                                    write FDebugLevel;
    property WebSrvIP: string                       read  FWebSrvIP
                                                    write FWebSrvIP;
    property WebSrvIP2: string                      read  FWebSrvIP2
                                                    write FWebSrvIP2;          { V8.65 }
    property WebSrvPort: string                     read  FWebSrvPort
                                                    write FWebSrvPort;
    property WebSrvPortSsl: string                  read  FWebSrvPortSsl
                                                    write FWebSrvPortSsl;
    property WebSrvCertBundle: string               read  FWebSrvCertBundle
                                                    write FWebSrvCertBundle;   { V8.62  }
    property WebSrvCertPassword: string             read  FWebSrvCertPassword
                                                    write FWebSrvCertPassword;
    property WebSrvHostName: string                 read  FWebSrvHostName
                                                    write FWebSrvHostName;
    property WebSrvRootFile: string                 read  FWebSrvRootFile
                                                    write FWebSrvRootFile;
    property OnSimpWebSrvReq: TSimpleWebSrvReqEvent read  FOnSimpWebSrvReq
                                                    write FOnSimpWebSrvReq;
    property OnServerProg: THttpRestProgEvent       read  FOnServerProg
                                                    write FOnServerProg;
    property OnSimpWebSrvAlpn: TClientAlpnChallgEvent read  FOnSimpWebSrvAlpn
                                                    write FOnSimpWebSrvAlpn; { V8.62 }

  end;

{ TRestOAuth is for handling 0Auth authorization to web apps. Beware OAuth
  does not normally allow applications to specify the actual login to the
  app, this is done via a browser web page }

 type
  TOAuthUri = record     { V8.65 }
    CAccName: string;
    CConsoleUrl: string;
    CAppUrl: string;
    CRedirectUrl: string;
    CTokenUrl: string;
    CReqTokUrl: string;  // OAuth1 only
    CScope: string;
//    CWebSrvIP: string;
//    CWebSrvPort: string;
  end;
  TOAuthUris = array of TOAuthUri;

{ V8.65 these TOAuthUri records are designed to set-up common OAuth2 account
  settings, by using the LoadAuthUri method.  Note to avoid draggings all
  URIs into all applications, they need to be referenced specifically in
  applications.  The REST sample builds an array to allow them to be selected
  from a list.  Note scope=offline may be needed to get a refresh token  }

const
  OAuthUriNone: TOAuthUri = (
    CAccName: 'None' );

  OAuthUriCertCenter: TOAuthUri = (
    CAccName: 'CertCenter Account';
    CConsoleUrl: 'https://my.certcenter.com/my/dashboard';
    CAppUrl: 'https://www.certcenter.com/oauth2/auth';
    CRedirectUrl: 'http://localhost:8080/certcenter/';
    CTokenUrl: 'https://api.certcenter.com/oauth2/token';
    CScope: 'write' );

  OAuthUriGoogle: TOAuthUri = (
    CAccName: 'Google Account';
    CConsoleUrl: 'https://console.developers.google.com/';
    CAppUrl: 'https://accounts.google.com/o/oauth2/auth';
    CRedirectUrl: 'http://localhost:8080/gmail/';
    CTokenUrl: 'https://accounts.google.com/o/oauth2/token';
    CScope: 'https://mail.google.com/' );

// Microsoft identity platform OAuth2
// in the URLs, <MsUserAuth> will be replaced by the MsUserAuthority property that can be:
// common = personal/work/school accounts, consumers = Microsoft Account users, organizations = work/school accounts, Azure Active Directory tenant GUID
  OAuthMsUserAuthDef = 'consumers';     { V8.70 }
  OAuthUriMSRest: TOAuthUri = (
    CAccName: 'Microsoft REST Mail APIs';
    CConsoleUrl: 'https://portal.azure.com/#blade/Microsoft_AAD_RegisteredApps/ApplicationsListBlade';
    CAppUrl: 'https://login.microsoftonline.com/<MsUserAuth>/oauth2/v2.0/authorize';    { V8.70 <MsUserAuth> instead of consumers so it can be changed }
    CRedirectUrl: 'http://localhost:8080/microsoft/';
    CTokenUrl: 'https://login.microsoftonline.com/<MsUserAuth>/oauth2/v2.0/token';
    CScope: 'openid offline_access email profile https://graph.microsoft.com/mail.read https://graph.microsoft.com/mail.send https://graph.microsoft.com/mailboxsettings.read' );

  OAuthUriMSSmtp: TOAuthUri = (
    CAccName: 'Microsoft SMTP/POP3';
    CConsoleUrl: 'https://portal.azure.com/#blade/Microsoft_AAD_RegisteredApps/ApplicationsListBlade';
    CAppUrl: 'https://login.microsoftonline.com/<MsUserAuth>/oauth2/v2.0/authorize';
    CRedirectUrl: 'http://localhost:8080/microsoft/';
    CTokenUrl: 'https://login.microsoftonline.com/<MsUserAuth>/oauth2/v2.0/token';
    CScope: 'offline_access https://outlook.office.com/SMTP.Send https://outlook.office.com/POP.AccessAsUser.All' );
 // beware, attempting to add profile to scope makes it fail so we can not get email account

  OAuthUriTwitterOA2: TOAuthUri = (
    CAccName: 'Twitter OAuth2 Account';
    CConsoleUrl: 'https://developer.twitter.com/en/account/';
    CAppUrl: 'https://api.twitter.com/oauth/authenticate';
    CRedirectUrl: 'http://localhost:8080/twitter/';
    CTokenUrl: 'https://api.twitter.com/oauth2/token';
    CScope: 'write' );

  OAuthUriTwitterOA1: TOAuthUri = (
    CAccName: 'Twitter OAuth1 Account';
    CConsoleUrl: 'https://developer.twitter.com/en/account/';
    CAppUrl: '';
    CRedirectUrl: 'http://localhost:8080/twitter/';
    CTokenUrl: 'https://api.twitter.com/oauth/access_token';
    CReqTokUrl: 'https://api.twitter.com/oauth/request_token';
    CScope: 'write' );

  OAuthUriSipgate: TOAuthUri = (
    CAccName: 'Sipgate Account';
    CConsoleUrl: 'https://app.sipgate.com/';
    CAppUrl: 'https://login.sipgate.com/auth/realms/third-party/protocol/openid-connect/auth';
    CRedirectUrl: 'http://localhost:8080/sipgate/';
    CTokenUrl: 'https://login.sipgate.com/auth/realms/third-party/protocol/openid-connect/token';
    CScope: 'sessions:sms:write:account:balance' );

{ OAuthUriTwilio: TOAuthUri = (
    CAccName: 'Twilio Account';
    CConsoleUrl: 'https://www.twilio.com/console';
    CAppUrl: '';
    CRedirectUrl: 'http://localhost:8080/twilio/';
    CTokenUrl: '';
    CScope: '' );   }


type
  TRestOAuth = class(TIcsWndControl)
  private
    { Private declarations }
    FDebugLevel: THttpDebugLevel;
    FAccToken: string;
    FAppUrl: string;
    FAuthCode: string;
    FAuthType: TOAuthType;
    FClientId: string;
    FClientSecret: string;
    FScope: string;
    FExpireDT: TDateTime;
    FLastErrCode: Integer;
    FLastError: String;
    FLastWebTick: Int64;        { V8.71 }
    FOAOptions: TOAuthOptions;
    FProtoType: TOAuthProto;
    FRedirectMsg: string;
    FRedirectUrl: string;
    FRefreshAuto: Boolean;
    FRefreshTimer: TIcsTimer;
    FRefrMinsPrior: Integer;
    FRefreshDT: TDateTime;
    FRefreshToken: string;
    FTokenUrl: string;
    FWebSrvIP: string;
    FWebSrvPort: string;
    FWebServer: TSimpleWebSrv;
    FRedirState: string;
    FRefreshOffline: Boolean;  { V8.63 }
    FLoginPrompt: string;      { V8.63 }
    FAccTokSecret: string;     { V8.65 for OAuth1 }
    FReqTokUrl: string;        { V8.65 for OAuth1 }
    FReqToken: string;         { V8.65 for OAuth1 }
    FReqTokSecret: string;     { V8.65 for OAuth1 }
    FAccName: string;          { V8.65 display only - Provider Account Name  }
    FConsoleUrl: string;       { V8.65 display only }
    FResponseMode: string;     { V8.65 OAuth2 redirect }
    FLoginHint: string;        { V8.65 OAuth2 prefill username/email }
    FMsUserAuthority: string;  { V8.70 Microsoft User Authority for account }
    FEdgeCacheDir: string;     { V8.71 where Edge browser should cache files, empty uses tempdir }
    FOnOAuthProg: THttpRestProgEvent;
    FOnOAuthAuthUrl: TOAuthAuthUrlEvent;
    FOnOAuthEmbed: TOAuthEmbedBrowEvent;    { V8.71 }
    FOnOAuthNewCode: TNotifyEvent;
    FOnOAuthNewToken: TNotifyEvent;
  protected
    { Protected declarations }
    procedure RestProg(Sender: TObject; LogOption: TLogOption; const Msg: string);
    procedure SetRefreshDT;
    procedure SetRefreshAuto(Value: Boolean);
    procedure SetRefreshToken(Value: String);
    procedure SetExpireDT(Value: TDateTime);
    procedure WebSrvReq(Sender: TObject; const Host, Path, Params: string; var RespCode, Body: string);
    function  GetToken: boolean;
    procedure RefreshOnTimer(Sender: TObject);
    procedure WebSrvProg(Sender: TObject; LogOption: TLogOption; const Msg: string);  { V8.63 }
    function  GetNonce: String;                                                       { V8.65 }

  public
    { Public declarations }
    HttpRest:    TSslHttpRest;
    OAuthParams: TRestParams;                                                   { V8.65 }
    constructor  Create (Aowner: TComponent); override;
    destructor   Destroy; override;
    procedure    LogEvent(const Msg: String);
    procedure    SetError(ErrCode: Integer; const Msg: String);
    function     StartSrv: boolean ;
    function     StopSrv(CloseClients: Boolean = True): boolean ;               { V8.65 }
    function     SrvIsRunning: Boolean;
    function     StartAuthorization: boolean;
    function     GrantAuthToken(const Code: String = ''): boolean;
    function     GrantRefresh: boolean;
    function     GrantPasswordToken(const User, Pass: String): boolean;
    function     GrantAppToken: boolean;
    function     TestRedirect: boolean;
    function     GetOAuthSignature(const Req, Url: string; ReqTok: Boolean = False): String;   { V8.65 }
    procedure    LoadAuthUri(AuthUri: TOAuthUri);                                              { V8.65 }
    function     LaunchConsole: boolean;                                                       { V8.65 }
    procedure    Close;                                                                        { V8.65 }
    procedure    FormLogEvent(const Line: String);                                                  { V8.71 }
    procedure    FormRedirEvent(const NewUrl: String; var HtmlBody: String; var CanClose: Boolean); { V8.71 }
    property     LastErrCode: Integer               read  FLastErrCode;
    property     LastError: String                  read  FLastError;
    property     RefreshDT: TDateTime               read  FRefreshDT;
  published
    { Published declarations }
    property DebugLevel: THttpDebugLevel            read  FDebugLevel
                                                    write FDebugLevel;
    property AppUrl: string                         read  FAppUrl
                                                    write FAppUrl;
    property AuthCode: string                       read  FAuthCode
                                                    write FAuthCode;
    property AuthType: TOAuthType                   read  FAuthType
                                                    write FAuthType;
    property ClientId: string                       read  FClientId
                                                    write FClientId;
    property ClientSecret: string                   read  FClientSecret
                                                    write FClientSecret;
    property ExpireDT: TDateTime                    read  FExpireDT
                                                    write SetExpireDT;
    property OAOptions: TOAuthOptions               read  FOAOptions
                                                    write FOAOptions;
    property ProtoType: TOAuthProto                 read  FProtoType
                                                    write FProtoType;
    property RedirectMsg: string                    read  FRedirectMsg
                                                    write FRedirectMsg;
    property RedirectUrl: string                    read  FRedirectUrl
                                                    write FRedirectUrl;
    property RefreshAuto: Boolean                   read  FRefreshAuto
                                                    write SetRefreshAuto;
    property RefrMinsPrior: Integer                 read  FRefrMinsPrior
                                                    write FRefrMinsPrior;
    property RefreshToken: string                   read  FRefreshToken
                                                    write SetRefreshToken;
    property Scope: string                          read  FScope
                                                    write FScope;
    property TokenUrl: string                       read  FTokenUrl
                                                    write FTokenUrl;
    property WebSrvIP: string                       read  FWebSrvIP
                                                    write FWebSrvIP;
    property WebSrvPort: string                     read  FWebSrvPort
                                                    write FWebSrvPort;
    property RefreshOffline: Boolean                read  FRefreshOffline
                                                    write FRefreshOffline;  { V8.63 }
    property LoginPrompt: string                    read  FLoginPrompt
                                                    write FLoginPrompt;     { V8.63 }
    property ReqTokUrl: string                      read  FReqTokUrl
                                                    write FReqTokUrl;       { V8.65 for OAuth1 }
    property AccToken: string                       read  FAccToken
                                                    write FAccToken;        { V8.65 for OAuth1 }
    property AccTokSecret: string                   read  FAccTokSecret
                                                    write FAccTokSecret;    { V8.65 for OAuth1 }
    property AccName: string                        read  FAccName
                                                    write FAccName;         { V8.65 display only }
    property ConsoleUrl: string                     read  FConsoleUrl
                                                    write FConsoleUrl;      { V8.65 display only }
    property ResponseMode: string                   read  FResponseMode
                                                    write FResponseMode;    { V8.65 OAuth2 query }
    property LoginHint: string                      read  FLoginHint
                                                    write FLoginHint;       { V8.65 OAuth2 prefill username/email }
    property MsUserAuthority: string                read  FMsUserAuthority
                                                    write FMsUserAuthority; { V8.70 Microsoft User Authority for account }
    property EdgeCacheDir: string                   read  FEdgeCacheDir
                                                    write FEdgeCacheDir;    { V8.71 where Edge browser should cache files }
    property OnOAuthEmbed: TOAuthEmbedBrowEvent     read  FOnOAuthEmbed
                                                    write FOnOAuthEmbed;    { V8.71 embedded browser event }
    property OnOAuthAuthUrl: TOAuthAuthUrlEvent     read  FOnOAuthAuthUrl
                                                    write FOnOAuthAuthUrl;
    property OnOAuthProg: THttpRestProgEvent        read  FOnOAuthProg
                                                    write FOnOAuthProg;
    property OnOAuthNewCode: TNotifyEvent           read  FOnOAuthNewCode
                                                    write FOnOAuthNewCode;
    property OnOAuthNewToken: TNotifyEvent          read  FOnOAuthNewToken
                                                    write FOnOAuthNewToken;
  end;

{ V8.65 TIcsTwitter to send and receive tweets }
  TIcsTwitter = class(TIcsWndControl)
  private
    { Private declarations }
    FRestOAuth: TRestOAuth;
    FDebugLevel: THttpDebugLevel;
    FLastErrCode: Integer;
    FLastError: String;
    FResponseJson: ISuperObject;
    FResponseRaw: UnicodeString;
    FConApiKey: string;
    FConApiSecret: string;
    FAccToken: string;
    FAccTokSecret: string;
    FRedirectUrl: string;
    FForceLogin: Boolean;
    FAccUserId: string;
    FAccScreenName: string;
    FLastTweetId: string;
    FBaseURL: String;
    FOAAuthType: TOAuthType;              { V8.71 }
    FOAEdgeCacheDir: string;              { V8.71 }
    FOnTwitProg: THttpRestProgEvent;
    FOnTwitNewToken: TNotifyEvent;
    FOnTwitEmbed: TOAuthEmbedBrowEvent;    { V8.71 }
  protected
    { Protected declarations }
    procedure TwitRestProg(Sender: TObject; LogOption: TLogOption; const Msg: string);
//    procedure TwitRestRequestDone(Sender: TObject; RqType: THttpRequest; ErrCode: Word);
    procedure TwitNewToken(Sender: TObject);
  public
    { Public declarations }
    HttpRest:  TSslHttpRest;
    constructor  Create (Aowner: TComponent); override;
    destructor   Destroy; override;
    function     StartAuthorization: boolean;
    function     CommonSettings: boolean;
    function     SendTweet(const Msg: String): boolean;
    function     GetAccSett: boolean;
    function     SearchTweets(const Query: String): boolean;
    function     ListTweets(const IdList: String): boolean;
    property     AccUserId: string                  read  FAccUserId;
    property     AccScreenName: string              read  FAccScreenName;
    property     LastTweetId: string                read  FLastTweetId;
    property     LastErrCode: Integer               read  FLastErrCode;
    property     LastError: String                  read  FLastError;
  published
    { Published declarations }
    property ResponseRaw: UnicodeString             read  FResponseRaw;
    property ResponseJson: ISuperObject             read  FResponseJson;
    property ConApiKey: string                      read  FConApiKey
                                                    write FConApiKey;
    property ConApiSecret: string                   read  FConApiSecret
                                                    write FConApiSecret;
    property RedirectUrl: string                    read  FRedirectUrl
                                                    write FRedirectUrl;
    property AccToken: string                       read  FAccToken
                                                    write FAccToken;
    property AccTokSecret: string                   read  FAccTokSecret
                                                    write FAccTokSecret;
    property ForceLogin: Boolean                    read  FForceLogin
                                                    write FForceLogin;
    property DebugLevel: THttpDebugLevel            read  FDebugLevel
                                                    write FDebugLevel;
    property OAAuthType: TOAuthType                 read  FOAAuthType
                                                    write FOAAuthType;         { V8.71 }
    property OAEdgeCacheDir: string                 read  FOAEdgeCacheDir
                                                    write FOAEdgeCacheDir;     { V8.71 }
    property OnTwitProg: THttpRestProgEvent         read  FOnTwitProg
                                                    write FOnTwitProg;
    property OnTwitNewToken: TNotifyEvent           read  FOnTwitNewToken
                                                    write FOnTwitNewToken;
    property OnTwitEmbed: TOAuthEmbedBrowEvent      read  FOnTwitEmbed
                                                    write FOnTwitEmbed;       { V8.71 embedded browser event }
  end;


{ V8.65 TIcsRestEmail to send and receive email with Google and Microsoft REST APIs }

  TRestEmailType = (RestEmailGoogle, RestEmailMSRest, RestEmailMSSmtp);
  TRestEmailFmt = (EmailFmtHdr, EmailFmtRaw, EmailFmtFull);

  TIcsRestEmail = class(TIcsWndControl)
  private
    { Private declarations }
    FRestOAuth: TRestOAuth;
    FDebugLevel: THttpDebugLevel;
    FLastErrCode: Integer;
    FLastError: String;
    FResponseJson: ISuperObject;
    FResponseRaw: UnicodeString;
    FRestEmailType: TRestEmailType;
    FCliID: string;
    FCliSecret: string;
    FAccToken: string;
    FRefrToken: string;
    FAccExpireDT: TDateTime;
    FForceLogin: Boolean;
    FAccountHint: string;
    FLoginTimeout: Integer;
    FNewAccEmail: string;
    FNewAccName: string;
    FNewAccScope: string;
    FTokenType: string;
    FCancelFlag: Boolean;
    FHdrFieldList: String;
    FWaitSecs: Integer;
    FLastEmailId: string;
    FBaseURL: String;
    FOnEmailProg: THttpRestProgEvent;
    FOnEmailNewToken: TNotifyEvent;
    FOAAuthType: TOAuthType;              { V8.66 }
    FOnOAAuthUrl: TOAuthAuthUrlEvent;     { V8.66 }
    FMsUserAuth: string;                  { V8.70 Microsoft User Authority for account }
    FOAEdgeCacheDir: string;              { V8.71 }
    FOnOAEmbed: TOAuthEmbedBrowEvent;    { V8.71 }
  protected
    { Protected declarations }
    procedure EmailRestProg(Sender: TObject; LogOption: TLogOption; const Msg: string);
    procedure EmailNewToken(Sender: TObject);
    procedure SetRestError;
    procedure SetOAuthErrs;              { V8.66 }
    function  CommonSettings: boolean;
  public
    { Public declarations }
    HttpRest:  TSslHttpRest;
    constructor  Create (Aowner: TComponent); override;
    destructor   Destroy; override;
    procedure    Clear;
    function     TestRedirect: boolean;
    function     StartAuthorization: boolean;
    function     UpdateToken: Boolean;
    function     GetNewToken(Interactive: Boolean = False): Boolean;
    procedure    CancelWait;
    function     LaunchConsole: boolean;
    function     GetProfile: boolean;
    function     ListEmails(const Query: String = ''; const MBLabels: String = 'INBOX'; MaxNr: Integer = 100): boolean;
    function     GetEmail(const Id: String; EmailFmt: TRestEmailFmt = EmailFmtHdr): boolean;
    function     SendEmail(const Content: String): boolean;
    function     DeleteEmail(const Id: String): boolean;
    property     NewAccEmail: string                read  FNewAccEmail;
    property     NewAccName: string                 read  FNewAccName;
    property     NewAccScope: string                read  FNewAccScope;
    property     TokenType: string                  read  FTokenType;
    property     LastEmailId: string                read  FLastEmailId;
    property     LastErrCode: Integer               read  FLastErrCode;
    property     LastError: String                  read  FLastError;
    property     WaitSecs: Integer                  read  FWaitSecs;
  published
    { Published declarations }
    property ResponseRaw: UnicodeString             read  FResponseRaw;
    property ResponseJson: ISuperObject             read  FResponseJson;
    property RestEmailType: TRestEmailType          read  FRestEmailType
                                                    write FRestEmailType;
    property ClientId: string                       read  FCliId
                                                    write FCliId;
    property ClientSecret: string                   read  FCliSecret
                                                    write FCliSecret;
    property AccToken: string                       read  FAccToken
                                                    write FAccToken;
    property AccExpireDT: TDateTime                 read  FAccExpireDT
                                                    write FAccExpireDT;
    property RefrToken: string                      read  FRefrToken
                                                    write FRefrToken;
    property ForceLogin: Boolean                    read  FForceLogin
                                                    write FForceLogin;
    property AccountHint: string                    read  FAccountHint
                                                    write FAccountHint;
    property LoginTimeout: Integer                  read  FLoginTimeout
                                                    write FLoginTimeout;
//    property MaxHdrs: Integer                       read  FMaxHdrs
//                                                    write FMaxHdrs;
    property HdrFieldList: String                   read  FHdrFieldList
                                                    write FHdrFieldList;
    property DebugLevel: THttpDebugLevel            read  FDebugLevel
                                                    write FDebugLevel;
    property OAAuthType: TOAuthType                 read  FOAAuthType
                                                    write FOAAuthType;     { V8.66 }
    property MsUserAuth: string                     read  FMsUserAuth
                                                    write FMsUserAuth;     { V8.70 Microsoft User Authority for account }
    property OAEdgeCacheDir: string                 read  FOAEdgeCacheDir
                                                    write FOAEdgeCacheDir; { V8.71 }
    property OnEmailProg: THttpRestProgEvent        read  FOnEmailProg
                                                    write FOnEmailProg;
    property OnEmailNewToken: TNotifyEvent          read  FOnEmailNewToken
                                                    write FOnEmailNewToken;
    property OnOAAuthUrl: TOAuthAuthUrlEvent        read  FOnOAAuthUrl
                                                    write FOnOAAuthUrl;    { V8.66 }
    property OnOAEmbed: TOAuthEmbedBrowEvent        read  FOnOAEmbed
                                                    write FOnOAEmbed;      { V8.71 embedded browser event }
  end;


function IcsShellExec(aFile: String; var PID: LongWord): Boolean; overload;
function IcsShellExec(aFile: String): Boolean; overload;
function IcsLoadRestEmailFromIni(MyIniFile: TCustomIniFile; MyRestEmail:
                TIcsRestEmail; const Section: String = 'RestEmail'): Boolean;         { V8.70 }

{$ENDIF USE_SSL}

implementation

{$IFDEF LINUX}
uses FMUX.Api;                { V8.65 for FmuxOpenUrl }
{$ENDIF}

{$IFDEF USE_SSL}


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ run a program, URL or document, returning process handle }
{ beware CoInitializeEx may be needed for some shell extensions }
function IcsShellExec(aFile: String; var PID: LongWord): Boolean;
var
{$IFDEF MSWINDOWS}
    ShellInfo: TShellExecuteInfoW;
{$ENDIF MSWINDOWS}
    WideFileName: WideString;
begin
    PID := 0;
    WideFileName := aFile;
{$IFDEF MSWINDOWS}
    FillChar(Shellinfo, SizeOf(Shellinfo), 0);
    with ShellInfo do begin
        cbSize := SizeOf(TShellExecuteInfo);
        fmask := SEE_MASK_NOCLOSEPROCESS OR
                         SEE_MASK_FLAG_DDEWAIT OR  SEE_MASK_FLAG_NO_UI ;
        Wnd := hInstance;
        lpVerb := 'open';
        lpFile := PWideChar(WideFileName);
        nShow :=  SW_NORMAL;
    end ;
    Result := ShellExecuteExW(@shellinfo);
    if Result then PID := ShellInfo.hProcess;
{$ENDIF MSWINDOWS}
{$IFDEF POSIX}
   Result := False;
    {$IFDEF LINUX}
    try
        FmuxOpenUrl(PChar(WideFileName));  { V8.65 }
        Result := True;
    except
    end;
  {$ENDIF LINUX}
  {$IFDEF MACOS}
  {$MESSAGE 'TODO ShellExec MACOS'}
  {$ENDIF MACOS}
{$ENDIF POSIX}
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ run a program, URL or document }
function IcsShellExec(aFile: String): Boolean;
var
    PID: LongWord;
begin
    Result := IcsShellExec(aFile, PID);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{  TSimpleWebSrv }
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor TSimpleWebSrv.Create (Aowner: TComponent);
begin
    inherited Create(AOwner);
    FWebServer := TSslWSocketServer.Create(Self);
    FWebServer.SslEnable := false;
    FWebServer.MaxClients := 10;
    FWebServer.Banner := '';
    FWebServer.BannerTooBusy := '';
    FWebServer.ClientClass := TSimpleClientSocket;
    FWebServer.OnClientConnect := ServerClientConnect;
    FWebServer.OnClientDisconnect := ServerClientDisconnect;
    FWebServer.OnBgException := SocketBgException;
    FWebServer.SocketErrs := wsErrFriendly;
{$IFNDEF NO_DEBUG_LOG}
    SrvLogger := TIcsLogger.Create (nil);
    SrvLogger.OnIcsLogEvent := IcsLogEvent;
    SrvLogger.LogOptions := [loDestEvent];
    FWebServer.IcsLogger := SrvLogger;
{$ENDIF}
    FWebSrvIP := ICS_LOCAL_HOST_NAME;   { V8.65 }
    FWebSrvPort := '8080';
    FWebSrvPortSsl := '0';
    FWebSrvHostName := ICS_LOCAL_HOST_NAME;
    FDebugLevel := DebugConn;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor TSimpleWebSrv.Destroy;
begin
    try
{$IFNDEF NO_DEBUG_LOG}
        FreeAndNil(SrvLogger) ;
{$ENDIF}
        FreeAndNil(FWebServer);
    finally
        inherited Destroy;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TSimpleWebSrv.StartSrv: boolean ;
var
    S: String;
begin
    Result := False;
    try
{$IFNDEF NO_DEBUG_LOG}
        if FDebugLevel >= DebugSslLow then
            SrvLogger.LogOptions := SrvLogger.LogOptions + [loSslInfo, loProtSpecInfo];
{$ENDIF}
        FWebServer.IcsHosts.Clear;
        FWebServer.IcsHosts.Add;  // only need one host
        with FWebServer.IcsHosts [0] do
        begin
            HostEnabled := True;
            if FWebSrvIP = ICS_LOCAL_HOST_NAME then begin   { V8.65 common }
                BindIpAddr := ICS_LOCAL_HOST_V4;
        //        if IsIPV6Available then
                    BindIpAddr2 := ICS_LOCAL_HOST_V6;
            end
            else begin
                BindIpAddr := FWebSrvIP;
                BindIpAddr2 := FWebSrvIP2;       { V8.65 might need IPv6 as well }
            end;
            HostNames.Text := FWebSrvHostName;
            BindNonPort := atoi(FWebSrvPort);
            if FWebSrvPortSsl <> '0' then begin  { V8.62 support SSL }
                BindSslPort := atoi(FWebSrvPortSsl) ;
                HostTag := 'SimpleServer' ;
                Descr := HostTag;
                SslSrvSecurity := sslSrvSecTls12Less;
                SslCert := IcsTrim(FWebSrvCertBundle);
                SslPassword := IcsTrim(FwebSrvCertPassword);
             {   if Assigned(FOnSimpWebSrvAlpn) then begin
                    CertSupplierProto := SuppProtoAcmeV2;
                    CertChallenge := ChallAlpnSrv;
                    FWebServer.SslCertAutoOrder := true;
                end; }
                FWebServer.RootCA := FWebSrvRootFile;
                S := FWebServer.ValidateHosts(False, False);  // don't stop on error, might be self signed certs }
                LogEvent(S);
            end;
        end;
        FWebServer.ExclusiveAddr := true;
        S := FWebServer.MultiListenEx;    // start listening for incoming connections
        if S = '' then
            Result := True
        else
            LogEvent(S);
    except
        on E:Exception do begin
            LogEvent('Web Server failed to start: ' + E.Message);
        end;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ V8.65 added CloseClients, if don't close we can call from event to stop listening only }
function TSimpleWebSrv.StopSrv(CloseClients: Boolean = True): boolean ;
var
    I: integer;
    StartTick: Int64;        { V8.71 }
begin
    try
        if FWebServer.State <> wsClosed then FWebServer.MultiClose;

     { V8.65 optionally abandon client sessions }
        if CloseClients and (FWebServer.ClientCount > 0) then begin
            for I := 0 to Pred (FWebServer.ClientCount) do begin
                if FWebServer.Client [I].State = wsConnected then
                                          FWebServer.Client [I].Close;
            end ;
        end ;
    except
        on E:Exception do begin
            LogEvent('Web Server failed to stop: ' + E.Message);
        end;
    end;

 // wait five seconds for server to close
    Result := IsRunning;
    if NOT Result then Exit;
    LogEvent('Waiting for Web Server to Stop');  { V8.65 }
    StartTick := IcsGetTickCount64;
    while True do begin
        MessagePump;
        Result := IsRunning;
        if NOT Result then break;
        if IcsElapsedSecs64(StartTick) > 5 then break;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TSimpleWebSrv.ListenStates: String;   { V8.62 }
begin
    Result := FWebServer.ListenStates;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSimpleWebSrv.LogEvent(const Msg : String);
begin
    if FDebugLevel = DebugNone then Exit;
    if Assigned(FOnServerProg) then
        FOnServerProg(Self, loProtSpecInfo, Msg) ;
end ;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSimpleWebSrv.IcsLogEvent(Sender: TObject; LogOption: TLogOption;
                                                      const Msg : String);
begin
    if Assigned(FOnServerProg) then
        FOnServerProg(Self, LogOption, Msg) ;
end ;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TSimpleWebSrv.IsRunning: Boolean;
begin
    Result := (FWebServer.State = wsListening);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSimpleWebSrv.SocketBgException(Sender: TObject;
                          E: Exception; var CanClose: Boolean);
begin
    LogEvent ('Web Server Exception: ' + E.Message) ;
    CanClose := true ;
end ;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSimpleWebSrv.ServerClientConnect(Sender: TObject; Client: TWSocketClient; Error: Word);
var
    Cli: TSimpleClientSocket;
begin
    if Error <> 0 then begin
        LogEvent('Server listen connect error: ' + WSocketErrorDesc(Error));  { V8.63 }
        Client.Close;
        exit;
    end;
    if FDebugLevel >= DebugConn then
       LogEvent({RFC3339_DateToStr(Now) + } 'Client Connected from Address ' + IcsFmtIpv6Addr(Client.GetPeerAddr));
    Cli := Client as TSimpleClientSocket;
    Cli.WebSrv := Self;
    Cli.LineMode := false;
    Cli.OnDataAvailable := Cli.CliDataAvailable;
    Cli.OnBgException := SocketBgException;
    Cli.OnSimpWebSrvReq := Self.FOnSimpWebSrvReq;
    Cli.OnClientAlpnChallg := Self.FOnSimpWebSrvAlpn; { V8.64 }
    Cli.Banner := '' ;
    Cli.RecvBufMax := 8096;  // only expecting a request header
    SetLength(Cli.RecvBuffer, Cli.RecvBufMax + 1);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSimpleWebSrv.ServerClientDisconnect(Sender: TObject;
                                 Client: TWSocketClient; Error: Word);
begin
    if FDebugLevel >= DebugConn then
        LogEvent('Client Disconnected') ;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ send local web page }
procedure TSimpleClientSocket.CliSendPage(const Status, ContentType, ExtraHdr, BodyStr: String);
var
    HttpRespHdr: string;
begin
  { create response header }
    HttpRespHdr := 'HTTP/1.0 ' + Status + IcsCRLF +
       'Content-Length: ' + IntToStr(Length(BodyStr)) + IcsCRLF +
       'Connection: close' + IcsCRLF;
    if (ContentType <> '') and (BodyStr <> '') then
        HttpRespHdr := HttpRespHdr + 'Content-Type: ' + ContentType + IcsCRLF;
    if ExtraHdr <> '' then
        HttpRespHdr := HttpRespHdr + ExtraHdr + IcsCRLF;
    HttpRespHdr := HttpRespHdr + IcsCRLF;

  { send header and body }
    if WebSrv.DebugLevel >= DebugHdr then
        WebSrv.LogEvent('Web Server Response:' + IcsCRLF + HttpRespHdr + BodyStr);
    SendStr(HttpRespHdr + BodyStr);
    CloseDelayed;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ create and send response error page }
procedure TSimpleClientSocket.CliErrorResponse(const RespStatus, Msg: string);
var
    BodyStr: string;
begin
    BodyStr := '<HTML><HEAD><TITLE>' + RespStatus + '</TITLE></HEAD>' + IcsCRLF +
            '<BODY>' + IcsCRLF +
            '<H1>' + RespStatus + '</H1>' + Msg + '<P>' + IcsCRLF +
            '</BODY></HTML>' + IcsCRLF;
    CliSendPage(RespStatus, 'text/html', '', BodyStr);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ note based on version from OverbyteIcsProxy but cut down to bare minimum }
procedure TSimpleClientSocket.ParseReqHdr;
var
    Line, Arg: String;
    I, J, K, L, Lines: Integer;
begin
    RequestMethod := httpABORT;
    RequestContentLength := 0;
    RequestHost := '';
    RequestHostName := '';
    RequestHostPort := '';
    RequestPath := '/';
    RequestParams := '';
    RequestReferer := '';
    RequestUserAgent := '';

 { process one line in header at a time }
    if Length(HttpReqHdr) <= 4 then Exit;  // sanity check
    I := 1; // start of line
    Lines := 1;
    for J := 1 to Length(HttpReqHdr) - 2 do begin
        if (HttpReqHdr[J] = IcsCR) and (HttpReqHdr[J + 1] = IcsLF) then begin  // end of line
            if (J - I) <= 2 then continue;  // ignore blank line, usually at start
            Line := Copy(HttpReqHdr, I, J - I);
            K := Pos (':', Line) + 1;
            if Lines = 1 then begin
                if (Pos('GET ', Line) = 1) then RequestMethod := httpGet;
                if (Pos('POST ', Line) = 1) then RequestMethod := httpPost;
                if (Pos('HEAD ', Line) = 1) then RequestMethod := httpHead;
                if (Pos('PUT ', Line) = 1) then RequestMethod := httpPut;
                L := Pos(' ', Line);
                if (L > 0) then Line := Copy(Line, L + 1, 99999); // strip request
                L := Pos(' HTTP/1', Line);
                if (L > 0) then begin
                    RequestPath := Copy(Line, 1, L - 1);
                    L := Pos('?', RequestPath);
                    if (L > 0) then begin
                        RequestParams := Copy(RequestPath, L + 1, 99999);
                        RequestPath := Copy(RequestPath, 1, L - 1);
                    end;
                    L := Pos('://', RequestPath);  // V8.62 look for full URL sent by proxy
                    if (L = 4) or (L = 5) then begin
                        RequestPath := Copy(RequestPath, L + 3, 99999);  // strip http://
                        L := Pos('/', RequestPath);  // start of path
                        if (L > 1) then
                            RequestPath := Copy(RequestPath, L, 999999);  // strip host
                    end;
                end;
            end
            else if (K > 3) then begin
                Arg := IcsTrim(Copy(Line, K, 999)); // convert any arguments we scan to lower case later
                if (Pos('Content-Length:', Line) = 1) then RequestContentLength := atoi64(Arg);
                if (Pos('Host:', Line) = 1) then begin
                    RequestHost := IcsLowerCase(Arg);  { need to separate host and port before punycoding }
                    L := Pos(':', RequestHost);
                    if L > 0 then begin
                        RequestHostName := IcsIDNAToUnicode(Copy(RequestHost, 1, L - 1));  { V8.64 }
                        RequestHostPort := Copy(RequestHost, L + 1, 99);
                        RequestHost := RequestHostName + ':' + RequestHostPort;      { V8.64 }
                    end
                    else begin
                        RequestHostName := IcsIDNAToUnicode(RequestHost); { V8.64 }
                        RequestHostPort := WebSrv.FWebSrvPort;
                        RequestHost := RequestHostName;       { V8.64 }
                    end;
                end;
                if (Pos('Referer:', Line) = 1) then RequestReferer := IcsLowercase(Arg);
                if (Pos('User-Agent:', Line) = 1) then RequestUserAgent := Arg;
            end;
            Lines := Lines + 1;
            I := J + 2;  // start of next line
        end;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TSimpleClientSocket.CliDataAvailable(Sender: TObject; Error: Word);
var
    RxRead, RxCount, LoopCounter, HdrLen: Integer;
    RespCode, Body: string;
begin
    try
        LoopCounter := 0;
        if RecvWaitTot < 0 then RecvWaitTot := 0; // sanity check
        while TRUE do begin
            inc (LoopCounter);
            if (LoopCounter > 100) then Break;    // sanity check
            RxCount := RecvBufMax - RecvWaitTot - 1;
            if RxCount <= 0 then Break;           // sanity check
            RxRead := Self.Receive (@RecvBuffer[RecvWaitTot], RxCount);
            if RxRead <= 0 then Break;            // nothing read
            RecvWaitTot := RecvWaitTot + RxRead;
        end;

      { search for blank line in receive buffer which means we have complete request header }
        HdrLen := IcsTBytesPos(IcsDoubleCRLF, RecvBuffer, 0, RecvWaitTot);
        if (HdrLen <= 0) then begin
            if (WebSrv.DebugLevel >= DebugBody) then
                WebSrv.LogEvent('Waiting for more source data');
            Exit;
        end ;
        HdrLen := HdrLen + 4; // add blank line length

      { keep headers in string so they are easier to process  }
      { ignore any body, don't care about POST requests }
        SetLength(HttpReqHdr, HdrLen);
        IcsMoveTBytesToString(RecvBuffer, 0, HttpReqHdr, 1, HdrLen);

       { see what was sent }
        ParseReqHdr;

       { ask user what we should do next }
        if (RequestMethod = httpGET) and Assigned(OnSimpWebSrvReq) then begin
            RespCode := '';
            try    { V8.65 always send response even if event crashes }
                OnSimpWebSrvReq(Self, RequestHost, RequestPath, RequestParams, RespCode, Body);
            except
                on E:Exception do
                    WebSrv.LogEvent('Error Processing Response: ' + E.Message);
            end;
            if RespCode <> '' then
                CliSendPage(RespCode, 'text/html', '', Body)
            else
                CliErrorResponse('500 Server Error', 'The requested URL ' +
                   TextToHtmlText(RequestPath) + ' was not processed by the server.');
        end
        else begin
            if WebSrv.DebugLevel >= DebugHdr then
                WebSrv.LogEvent({RFC3339_DateToStr(Now) + } 'Server Request Ignored, Host: ' +
                        RequestHost + ', Path: ' + RequestPath + ', Params: ' + RequestParams);   { V8.62 }
            CliErrorResponse('404 Not Found', 'The requested URL ' +
                 TextToHtmlText(RequestPath) + ' was not found on this server.');
        end;
    except
         on E:Exception do
            WebSrv.LogEvent('Error Receive Data: ' + E.Message);
    end ;
end ;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ TRestOAuth }
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor TRestOAuth.Create (Aowner: TComponent);
begin
    inherited Create(AOwner);
    FWebServer := TSimpleWebSrv.Create(self);
    FWebServer.OnServerProg := WebSrvProg;  { V8.63 got lost somehow }
    FWebServer.OnSimpWebSrvReq := WebSrvReq;
    HttpRest := TSslHttpRest.Create(self);
    HttpRest.OnHttpRestProg := RestProg;
    FWebSrvIP := ICS_LOCAL_HOST_NAME;         { V8.65 }
    FWebSrvPort := '8080';
    FDebugLevel := DebugConn;
    FProtoType := OAuthv2;
    FAuthType := OAuthTypeWeb;
    FRefrMinsPrior := 120;
    FRefreshDT := 0;
    FScope := '';
    FLoginPrompt := 'consent';                { V8.63 }
    FResponseMode := 'query';                 { V8.65 }
    FMsUserAuthority := OAuthMsUserAuthDef;   { V8.70 }
    OAuthParams := TRestParams.Create(self);  { V8.65 }
    OAuthParams.PContent := PContUrlencoded;
    OAuthParams.RfcStrict := True;   { Twitter needs strict RFC }
    Randomize;                           { V8.65 }
    FLastWebTick := Trigger64Disabled;   { V8.71 }
    FRefreshTimer := TIcsTimer.Create(HttpRest);
    FRefreshTimer.OnTimer := RefreshOnTimer;
    FRefreshTimer.Interval := TicksPerMinute;
    FRefreshTimer.Enabled := True;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor TRestOAuth.Destroy;
begin
    try
        FRefreshTimer.Enabled := False;
        StopSrv;
        FreeAndNil(FRefreshTimer);
        FreeAndNil(OAuthParams);
        FreeAndNil(HttpRest);
        FreeAndNil(FWebServer);
    finally
        inherited Destroy;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRestOAuth.RestProg(Sender: TObject; LogOption: TLogOption; const Msg: string);
begin
    if Assigned(FOnOAuthProg) then
        FOnOAuthProg(Self, LogOption, Msg) ;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRestOAuth.WebSrvProg(Sender: TObject; LogOption: TLogOption; const Msg: string);
begin
    if Assigned(FOnOAuthProg) then
        FOnOAuthProg(Self, LogOption, 'OAuth Web Server ' + Msg);    { V8.63 }
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRestOAuth.LogEvent(const Msg : String);
begin
    if FDebugLevel = DebugNone then Exit;
    if Assigned(FOnOAuthProg) then
        FOnOAuthProg(Self, loProtSpecInfo, Msg) ;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRestOAuth.SetError(ErrCode: Integer; const Msg: String);
begin
    FLastErrCode := ErrCode;
    FLastError := Msg;
    LogEvent(Msg);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRestOAuth.SetRefreshDT;
begin
    FRefreshDT := 0;
    if FRefreshToken = '' then Exit;
    if (FExpireDT < 10) then Exit;
    if (FRefrMinsPrior < 10) then FRefrMinsPrior := 10;
    FRefreshDT := FExpireDT - ((FRefrMinsPrior * 60) / SecsPerDay);
    if FRefreshAuto then
        LogEvent('Token will Automatically Refresh at: ' + DateTimeToStr(FRefreshDT));
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRestOAuth.SetExpireDT(Value: TDateTime);
begin
    if Value <> FExpireDT then begin
        FExpireDT := Value;
        SetRefreshDT;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRestOAuth.SetRefreshAuto(Value: Boolean);
begin
    if Value <> FRefreshAuto then begin
        FRefreshAuto:= Value;
        SetRefreshDT;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRestOAuth.SetRefreshToken(Value: String);
begin
    if Value <> FRefreshToken then begin
        FRefreshToken := Value;
        SetRefreshDT;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRestOAuth.LoadAuthUri(AuthUri: TOAuthUri);                           { V8.65 }
var
    I: Integer;
begin
    FAccName := AuthUri.CAccName;
    FConsoleUrl := AuthUri.CConsoleUrl;
    FAppUrl := AuthUri.CAppUrl;
    FReqTokUrl := AuthUri.CReqTokUrl;  { OAuth1A only }
    FRedirectUrl := AuthUri.CRedirectUrl;
    FTokenUrl := AuthUri.CTokenUrl;
    FScope := AuthUri.CScope;
    I := Pos(ICS_LOCAL_HOST_NAME, FRedirectUrl);
    if I = 8 then begin
        FWebSrvIP := ICS_LOCAL_HOST_NAME;
        I := IcsPosEx(':', FRedirectUrl, 9);
        if I > 0 then begin
            FWebSrvPort := Copy(FRedirectUrl, I + 1, 6);
            I := Pos('/', FWebSrvPort);
            if I > 2 then
                FWebSrvPort := Copy(FWebSrvPort, 1, I - 1);
         end;
     end;
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TRestOAuth.StartSrv: boolean ;
begin
    FWebServer.DebugLevel := Self.FDebugLevel;
    FWebServer.WebSrvIP := Self.FWebSrvIP;
    FWebServer.WebSrvPort := Self.FWebSrvPort;
    Result := FWebServer.StartSrv;
    FLastWebTick := Trigger64Disabled;  { V8.60 don't timeout until request }   { V8.71 }
    if Result then
        LogEvent('OAuth Web Server Started on: ' + IcsFmtIpv6AddrPort(FWebSrvIP, FWebSrvPort))
    else
        LogEvent('OAuth Web Server Failed to Start');
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TRestOAuth.StopSrv(CloseClients: Boolean = True): boolean ;            { V8.65 }
begin
    FLastWebTick := Trigger64Disabled;    { V8.71 }
    Result := FWebServer.StopSrv(CloseClients);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TRestOAuth.SrvIsRunning: Boolean;
begin
    Result := FWebServer.IsRunning;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRestOAuth.Close;                                                     { V8.65 }
begin
    if SrvIsRunning then StopSrv;
    if HttpRest.State = httpConnected then HttpRest.Close;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRestOAuth.RefreshOnTimer(Sender : TObject);
begin
    FRefreshTimer.Enabled := False;
    try
     // auto refresh token
        if FRefreshAuto and (FRefreshToken <> '') and (FRefreshDT <> 0) then begin
            if Now > FRefreshDT then begin
                FRefreshDT := 0;
                LogEvent('Starting Automatic Token Refresh');
                if NOT GrantRefresh then begin
                    LogEvent('Automatic Token Refresh Failed: ' + FLastError);
                end;
            end;
        end;

     // close web server on idle timeout - 30 minutes
        if SrvIsRunning and (IcsElapsedMins64(FLastWebTick) > 30) then begin     { V8.71 }
            FLastWebTick := Trigger64Disabled;
            LogEvent('OAuth Web Server Stopping on Idle Timeout');
            StopSrv;
        end;
    finally
        FRefreshTimer.Enabled := True;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ event called by simple web server when any page is requested }
{ V8.71, also called from FormRedirEvent for EdgeBrowser }
procedure TRestOAuth.WebSrvReq(Sender: TObject; const Host, Path, Params: string; var RespCode, Body: string);
var
    State, Code, Title, Msg, Error, Redirect, ErrorDesc: String;
    oauth_token, oauth_verifier: String;

    procedure BuildBody;
    begin
        Body := '<HTML><HEAD><TITLE>' + Title + '</TITLE></HEAD>' + IcsCRLF +
            '<BODY>' + IcsCRLF +
            '<H1>' + Title + '</H1>' + Msg + '<P>' + IcsCRLF +
            '<H2>Please Close this Window</H1>' + IcsCRLF +    { V8.71 }
            '</BODY></HTML>' + IcsCRLF;
        LogEvent('OAuth Web Response: ' + RespCode);
    end;

begin

 // ignore favicon requests completely
    if Path = '/favicon.ico' then begin
        RespCode := '404 Not Found';
        Title := RespCode;
        Msg := 'Error: File Not Found';
        BuildBody;
        Exit;
    end;

// if called from web server, report URL
   if Host <> '' then begin      { V8.71 }
        FLastWebTick := IcsGetTickCount64;   // timeout to close server
        LogEvent('OAuth Web Request, Host: ' + Host + ', Path: ' + Path + ', Params: ' + Params);
        Redirect := 'http://' + Host + Path;
        if Redirect <> FRedirectUrl then
            LogEvent('Warning, Differing Redirect URL: ' + Redirect);
    end;

  // for an OAuth authentication redirect, we don't really care about the path
    IcsExtractURLEncodedValue (Params, 'state', State) ;   // OAuth2
    IcsExtractURLEncodedValue (Params, 'code', Code) ;     // OAuth2
    IcsExtractURLEncodedValue (Params, 'error', Error) ;   // OAuth2
    IcsExtractURLEncodedValue (Params, 'oauth_token', oauth_token) ;       // OAuth1a
    IcsExtractURLEncodedValue (Params, 'oauth_verifier', oauth_verifier) ; // OAuth1a
    IcsExtractURLEncodedValue (Params, 'error_description', ErrorDesc);   // OAuth2 V8.65

  // V8.65 OAuth1A check expected request token, keep code
    if (FProtoType = OAuthv1A) then begin
        if (oauth_token <> FReqToken) and (oauth_verifier = '') then begin
            RespCode := '501 Internal Error';
            Title := 'OAuth Authorization Failed';
            Msg := 'Error: No OAuth1 Tokens Found';
            BuildBody;
            Exit;
        end;
        FAuthCode := oauth_verifier;
    end

  // OAuth2
    else begin
        if (Error <> '') then begin
            StopSrv(False);  { V8.65 stop server listening on error, don't close client }
            RespCode := '501 Internal Error';
            Title := 'OAuth Authorization Failed';
            Msg := 'Error: ' + Error + '<P>' + IcsCRLF + ErrorDesc;
            BuildBody;
            Exit;
        end;

        if (NOT (OAopAuthNoState in FOAOptions)) and
                (State = '') or (State <> FRedirState)  then begin
            StopSrv(False);  { V8.65 stop server listening on error, don't close client }
            RespCode := '501 Internal Error';
            Title := RespCode;
            Msg := 'Error: Unexpected State';
            BuildBody;
            Exit;
        end;

        if (Code = '') then begin
            StopSrv(False);  { V8.65 stop server listening on error, don't close client }
            RespCode := '501 Internal Error';
            Title := RespCode;
            Msg := 'Error: Can not find Authorization Code';
            BuildBody;
            Exit;
        end;
        FAuthCode := Code;
    end;

 // if not testing, save new code. try and get token
    Title := 'Authorization Code Generated Successfully';
    LogEvent('OAuth Web Request, ' + Title + ', ' + Code);  { V8.65 }
    Msg := '<p><b>App Authorization Code: ' + Code + '</b></p>' + IcsCRLF +
            '<b>' + FRedirectMsg + '</b></p>';
    RespCode := '200 OK';
    if FRedirState <> TestState then begin
        if Assigned(FOnOAuthNewCode) then
            FOnOAuthNewCode(Self);
        LogEvent('OAuth Web Request, Getting New Token');  { V8.65 }
        if GrantAuthToken(FAuthCode) then begin
            Title := 'App Token Generated Successfully';
            Msg := '<p><b>App Token Generated Successfully</b></p>' + IcsCRLF +
            '<b>' + FRedirectMsg + '</b></p>';
        end
        else
            Title := 'Failed to Generate App Token';
    end;
    BuildBody;
  { web page is sent by event handler }
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TRestOAuth.TestRedirect: boolean;
var
    StatCode: Integer;
begin
    Result := false;
    FLastErrCode := OAuthErrNoError;
    FLastError := '';
    if NOT SrvIsRunning then
        StartSrv;
    if NOT SrvIsRunning then begin
        SetError(OAuthErrWebSrv, 'Can Not Test Redirect, Web Server Will Not Start');
        Exit;
    end;
    if Pos ('http://', FRedirectUrl) <> 1 then begin
        SetError(OAuthErrParams, 'Can Not Test Redirect, Invalid Redirect URL: ' + FRedirectUrl);  { V8.70 }
        Exit;
    end;
    LogEvent('Redirect URL: ' + FRedirectUrl);                { V8.70 tell user }
    FRedirState := TestState;
    HttpRest.Reference := FRedirectUrl;
    HttpRest.DebugLevel := FDebugLevel;
    HttpRest.RestParams.Clear;
    HttpRest.RestParams.AddItem('state', FRedirState);
    HttpRest.RestParams.AddItem('code', '12345678901234567890');
    StatCode := HttpRest.RestRequest(HttpGET, FRedirectUrl, False, '');
    if StatCode <> 200 then
        SetError(OAuthErrWebSrv, 'Test Redirect Failed to: ' + FRedirectUrl)   { V8.70 }
     else begin
        LogEvent('Test Redirect OK');
        Result := true;
    end;
    StopSrv(False);  { V8.65 close server but not current client }
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TRestOAuth.GetNonce: String;                                      { V8.65 }
var
    I: Integer;
begin
    Result := '';
    for I := 1 to 16 do
        Result := Result + Chr(Random(26) + Ord('A')) + Chr(Random(26) + Ord('a'));
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ OAuth1A get SHA1 digest of request, URL and parameters, Base String }
{ OAuthParams may already have items }
{ everything strictly percent URL encooded according to RTF, in alpha order }
function TRestOAuth.GetOAuthSignature(const Req, Url: String; ReqTok: Boolean = False): String;    { V8.65 }
var
    SignBase, SignKey, Params: AnsiString;
begin
    SignKey := UrlEncodeToA(FClientSecret, CP_UTF8, True) + IcsAmpersand;
    OAuthParams.AddItem('oauth_consumer_key', FClientId);
    OAuthParams.AddItem('oauth_nonce', GetNonce);
    OAuthParams.AddItem('oauth_signature_method', 'HMAC-SHA1');
    OAuthParams.AddItem('oauth_timestamp', IntToStr(IcsGetUnixTime));
    if ReqTok then begin
        OAuthParams.AddItem('oauth_token', FReqToken);
        if FReqTokSecret <> '' then
          SignKey := SignKey + UrlEncodeToA(FReqTokSecret, CP_UTF8, True);
    end
    else begin
        OAuthParams.AddItem('oauth_token', FAccToken);
        if FAccTokSecret <> '' then
          SignKey := SignKey + UrlEncodeToA(FAccTokSecret, CP_UTF8, True);
    end;
    OAuthParams.AddItem('oauth_version', '1.0');
    OAuthParams.PContent := PContUrlencoded;
    Params := OAuthParams.GetParameters(True);  // sorted name order or hash fails
 // parameters are urlencoded a second time so only two & in signbase
    SignBase := AnsiString(IcsUpperCase(Req)) + IcsAmpersand +
                   UrlEncodeToA(Url, CP_UTF8, True) +
                        IcsAmpersand + UrlEncodeToA(String(Params), CP_UTF8, True);
    Result := String(Base64Encode(IcsHMACDigestEx(SignBase, SignKey, Digest_sha1)));
    LogEvent('OAuth1 Params: ' + String(Params) + IcsCRLF +
             'SignBase: ' + String(SignBase) +  IcsCRLF +
             'SignKey; ' + String(SignKey) + IcsCRLF +
             'Signature: ' + Result);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Launch browser with console or account URL }
function TRestOAuth.LaunchConsole: boolean;
begin
    Result := False;
    if FConsoleUrl = '' then begin
        SetError(OAuthErrParams, 'Can Not Launch Browser, Invalid Redirect URL');
        Exit;
    end;
    if IcsShellExec(FConsoleUrl) then begin
        LogEvent('Launched Browser to console: ' + FConsoleUrl);
        Result := True;
    end
    else begin
        SetError(OAuthErrBrowser, 'Failed to Launch Browser: ' + GetWindowsErr(GetLastError));
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Start user authorisation generally using an embedded or external browser to enter a login, which
   then redirects back to a local web server which gets the authorisation code }
function TRestOAuth.StartAuthorization: boolean;
var
    BrowserURL, Signature, CallBackOK, S: string;
    StatCode: Integer;
    ErrJson: ISuperObject;
begin
    Result := false;
    FLastErrCode := OAuthErrNoError;
    FLastError := '';
    if (FProtoType = OAuthv1) then begin
        SetError(OAuthErrParams, 'OAuth1 Not Supported');
        Exit;
    end;
    if Pos ('http://', FRedirectUrl) <> 1 then begin
        SetError(OAuthErrParams, 'Can Not Start Authorization, Invalid Redirect URL: ' + FRedirectUrl);
        Exit;
    end;
    if Pos ('https://', FAppUrl) <> 1 then begin
        SetError(OAuthErrParams, 'Can Not Start Authorization, Invalid App URL: ' + FAppUrl);
        Exit;
    end;
    if (FClientId = '') or (FClientSecret = '') then begin
        SetError(OAuthErrParams, 'Can Not Start Authorization, Need Client ID and Secret');
        Exit;
    end;
    HttpRest.DebugLevel := FDebugLevel;          { V8.65 }
    FAccToken := '';                             { V8.65 }
    FExpireDT := 0;                              { V8.65 }

// OAuth1A get request token and build URL for browser
    if (FProtoType = OAuthv1A) then begin
        FReqToken := '';
        FReqTokSecret := '';

    // build base string, used for hashed signature
    // must include POST content and URL paramaters, sorted
        OAuthParams.Clear;
        OAuthParams.AddItem('oauth_callback', FRedirectUrl);
        LogEvent('Redirect URL: ' + FRedirectUrl);                { V8.70 tell user }
        Signature := GetOAuthSignature('POST', FReqTokUrl, True);   // adds commom parameters

    // adjust base string for Authorization: OAuth header, add signature, leave callback
        OAuthParams.AddItem('oauth_signature', Signature);
        HttpRest.ServerAuth := httpAuthOAuth;
        OAuthParams.PContent := PContCommaList;  // change paramter format
        HttpRest.AuthBearerToken := String(OAuthParams.GetParameters(True)); // bearer is quoted encoded values, comma separated
        LogEvent('Authorization: OAuth ' + HttpRest.AuthBearerToken);

        HttpRest.RestParams.Clear;
        StatCode := HttpRest.RestRequest(httpPOST, FReqTokUrl, False, '');   { V8.71 !!!! fails, POST must havbe params!!! }
        if (StatCode <> 200) then begin
            S := HttpRest.ResponseRaw;
            if S = '' then
                S := HttpRest.LastResponse
            else begin
                if Assigned(HttpRest.ResponseJson) then begin
                    ErrJson := HttpRest.ResponseJson.O['errors'];
                    if Assigned(ErrJson) and (ErrJson.AsArray.Length > 0) then
                        S := ErrJson.AsArray.O[0].S['message'];
                end;
            end;
            SetError(OAuthErrParams, 'Can Not Get OAuth1 Request Token: ' + S);
            Exit;
        end
        else begin    // note getting request tokens not access tokens despite the labels!
          // this request does not return Json for some strange reason
            IcsExtractURLEncodedValue (HttpRest.ResponseRaw, 'oauth_token', FReqToken) ;
            IcsExtractURLEncodedValue (HttpRest.ResponseRaw, 'oauth_token_secret', FReqTokSecret) ;
            IcsExtractURLEncodedValue (HttpRest.ResponseRaw, 'oauth_callback_confirmed', CallBackOK) ;
        end;
        if (FReqToken = '') or (FReqTokSecret = '') then begin
            SetError(OAuthErrParams, 'Can Not Find OAuth1 Request Token in Response: ' + HttpRest.ResponseRaw);
            exit;
        end;
        OAuthParams.Clear;
        OAuthParams.PContent := PContUrlencoded;
        OAuthParams.AddItem('oauth_token', FReqToken);
        if (OAopAuthPrompt in FOAOptions) then
            OAuthParams.AddItem('force_login', 'true');
      // OAuthParams.AddItem('screen_name', '??' );     // prefill login name, if we had it
        BrowserURL := FAppUrl + '?' + String(OAuthParams.GetParameters);
   end

// OAuth2 build URL for browser
   else begin
        FRedirState := 'ICS-' + IntToStr(IcsGetTickCount64);   { V8.71 }
        OAuthParams.Clear;
        OAuthParams.PContent := PContUrlencoded;
        OAuthParams.AddItem('response_type', 'code');
        OAuthParams.AddItem('client_id', FClientId);
        if NOT (OAopAuthNoRedir in FOAOptions) then begin
            OAuthParams.AddItem('redirect_uri', FRedirectUrl);
            LogEvent('Redirect URL: ' + FRedirectUrl);                { V8.70 tell user }
        end;
        if NOT (OAopAuthNoState in FOAOptions) then
            OAuthParams.AddItem('state', FRedirState);
        if (NOT (OAopAuthNoScope in FOAOptions)) and (FScope <> '') then
            OAuthParams.AddItem('scope', FScope);
        if (OAopAuthPrompt in FOAOptions) and (FLoginPrompt <> '') then
            OAuthParams.AddItem('prompt', FLoginPrompt); { V8.63 none consent select_account }
        if (OAopAuthAccess in FOAOptions) then begin
            if FRefreshOffline then
                OAuthParams.AddItem('access_type', 'offline')   { V8.63 neeed so Google supplies refresh token }
            else
                OAuthParams.AddItem('access_type', 'online');
        end;
//        if FResource <> '' then
//            HttpRest.RestParams.AddItem('resource', FResource);                 { V8.65 }
        if (OAopAuthRespMode in FOAOptions) and (FResponseMode <> '') then
            OAuthParams.AddItem('response_mode', FResponseMode);        { V8.65 }
        if (OAopAuthLoginHint in FOAOptions) and (FLoginHint <> '') then
            OAuthParams.AddItem('login_hint', FLoginHint);              { V8.65 }
        if (OAopAuthGrantedScope in FOAOptions) then
            OAuthParams.AddItem('include_granted_scopes', true); { V8.65 incremental scopes, keep old ones }
     { V8.70 Microsoft has several URL variants }
        if FMsUserAuthority = '' then
            FMsUserAuthority := OAuthMsUserAuthDef;
        BrowserURL := StringReplace(FAppUrl, '<MsUserAuth>', FMsUserAuthority, [rfReplaceAll, rfIgnoreCase]) + '?' +
                                                                                           String(OAuthParams.GetParameters);
    end;
    LogEvent('Authorization URL: ' + BrowserURL);

  { various schemes to get authorization code from browser }
  { V8.57 need local web server for all methods }
    if (FAuthType = OAuthTypeWeb) or (FAuthType = OAuthTypeMan) {or (FAuthType = OAuthTypeEmbed) } then begin { V8.71 not for Embed }
        if NOT SrvIsRunning then
            StartSrv;
        if NOT SrvIsRunning then begin
            SetError(OAuthErrWebSrv, 'Can Not Start Authorization, Web Server Will Not Start');
            Exit;
        end;
    end;
    if FAuthType = OAuthTypeWeb then begin
        if IcsShellExec(BrowserURL) then begin
            LogEvent('Launched Browser to Login to application, once completed you should see "App Token Generated Successfully"');
            Result := True;
        end
        else begin
            SetError(OAuthErrBrowser, 'Failed to Launch Browser: ' + GetWindowsErr(GetLastError));
        end;
    end
  { V8.71 embedded browser, note returns when completed, not just started }
    else if (FAuthType = OAuthTypeEmbed) then begin
     // check if embedded browser event assigned, only need it for interactive applications
       if NOT Assigned(FOnOAuthEmbed) then
            SetError(OAuthErrParams, 'Embedded Browser Not Supported')
       else begin
            try
                FOnOAuthEmbed(Self, BrowserURL, Result);
                if NOT Result then begin
                    if FLastErrCode = 0 then
                        SetError(OAuthErrParams, 'Failed to Open Embedded Browser');
                end;
            except
                on E:Exception do
                    SetError(OAuthErrParams, 'Exception Opening Embedded Browser - ' + E.Message);
            end;
       end;
    end
    else if (FAuthType = OAuthTypeMan) then begin
        if Assigned (OnOAuthAuthUrl) then begin
            OnOAuthAuthUrl(Self, BrowserURL);
        end;
    end
    else
        SetError(OAuthErrParams, 'Can Not Start Authorization, Unknown Method');
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ get token using HttpRest.RestParams set-up before this call }
function TRestOAuth.GetToken: boolean;
var
    StatCode, secs: Integer;
    Info, Refresh, URL: string;
begin
    Result := false;
    HttpRest.DebugLevel := FDebugLevel;                  { V8.65 }
    LogEvent(String(HttpRest.RestParams.GetParameters));         { V8.71 }
    if FMsUserAuthority = '' then
       FMsUserAuthority := OAuthMsUserAuthDef;           { V8.70 }
    URL := StringReplace(FTokenUrl, '<MsUserAuth>', FMsUserAuthority, [rfReplaceAll, rfIgnoreCase]); { V8.70 }
    StatCode := HttpRest.RestRequest(HttpPOST, URL, False, '');
    if (StatCode = 0) or (NOT Assigned(HttpRest.ResponseJson)) then  { V8.55 }
        SetError(OAuthErrBadGrant, 'Token Exchange Failed: ' + HttpRest.LastResponse)
     else begin
        FAccToken := HttpRest.ResponseJson.S['access_token'];
        if FAccToken <> '' then begin
            Result := true;
            Refresh := HttpRest.ResponseJson.S['refresh_token'];
            secs := HttpRest.ResponseJson.I['expires_in'];
            FExpireDT := Now + (secs / SecsPerDay);
            FRefreshDT := 0;
            LogEvent('Got New Access Token: ' + FAccToken + IcsCRLF +   { V8.65 two lines }
                            'Which Expires: ' + DateTimeToStr(FExpireDT));

            if (Refresh = '') and (FRefreshToken = '') then
                LogEvent('No Refresh Token Available')
            else if Refresh <> '' then begin   { V8.63 don't kill old refresh if no new token }
                FRefreshToken := Refresh;
                LogEvent('Got New Refresh Token: ' + FRefreshToken);
            end;
        { V8.65 set auto refreesh if old token kept }
            if (FRefreshToken <> '') and FRefreshAuto and (FRefrMinsPrior > 30) and (secs > 300) then begin
                if (secs > (FRefrMinsPrior * 60)) then
                    FRefreshDT := FExpireDT - ((FRefrMinsPrior * 60) / SecsPerDay)
                else
                    FRefreshDT := FExpireDT - (300 / SecsPerDay); // five minutes
                LogEvent('Token will Automatically Refresh at: ' + DateTimeToStr(FRefreshDT));
            end ;
            try
                if Assigned(FOnOAuthNewToken) then
                    FOnOAuthNewToken(Self);
            except
                on E:Exception do
                    SetError(OAuthErrEvent, E.Message);      { V8.65 }
            end;
        end
        else begin
            Info := HttpRest.ResponseJson.S['error'];
            if Info <> '' then
                Info := 'Token Exchange Failed: ' + Info + ' - ' + HttpRest.ResponseJson.S['error_description']
            else
                Info := 'Token Exchange Failed: REST error: ' + HttpRest.ReasonPhrase;
            SetError(OAuthErrBadGrant, Info);
            LogEvent(HttpRest.ResponseRaw);
        end;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TRestOAuth.GrantAuthToken(const Code: String = ''): boolean;
var
    StatCode: integer;
    Signature, S: string;
    ErrJson: ISuperObject;
begin
    if Code <> '' then FAuthCode := Code;
    Result := false;
    FLastErrCode := OAuthErrNoError;
    FLastError := '';
    if Pos ('http://', FRedirectUrl) <> 1 then begin
        SetError(OAuthErrParams, 'Can Not Start Authorization, Invalid Redirect URL: ' + FRedirectUrl);  { V8.70 }
        Exit;
    end;
    if Pos ('https://', FTokenUrl) <> 1 then begin
        SetError(OAuthErrParams, 'Can Not Start Authorization, Invalid Token URL: ' + FTokenUrl);  { V8.70 }
        Exit;
    end;
    if (FAuthCode = '') then begin
        SetError(OAuthErrParams, 'Can Not Start Authorization, Missing Auth Code');
        Exit;
    end;
    if (FClientId = '') or (FClientSecret = '') then begin
        SetError(OAuthErrParams, 'Can Not Start Authorization, Need Client ID and Secret');
        Exit;
    end;

  // OAuth1A get access token using request token and oauth_verifier from callback or PIN
    if (FProtoType = OAuthv1A) then begin
    // build base string, used for hashed signature
    // must include POST content and URL paramaters, sorted
        OAuthParams.Clear;
        OAuthParams.AddItem('oauth_callback', FRedirectUrl);
        LogEvent('Redirect URL: ' + FRedirectUrl);                { V8.70 tell user }
        OAuthParams.AddItem('oauth_verifier', FAuthCode);
        Signature := GetOAuthSignature('POST', FTokenUrl, True);   // adds commom parameters

    // adjust base string for Authorization: OAuth header, add signature, leave callback
        OAuthParams.AddItem('oauth_signature', Signature);
        HttpRest.ServerAuth := httpAuthOAuth;
        OAuthParams.PContent := PContCommaList;  // change paramter format
        HttpRest.AuthBearerToken := String(OAuthParams.GetParameters(True)); // bearer is quoted encoded values, comma separated
        LogEvent('Authorization: OAuth ' + HttpRest.AuthBearerToken);

        HttpRest.RestParams.Clear;
        StatCode := HttpRest.RestRequest(httpPOST, FTokenUrl, False, '');
        if (StatCode <> 200) then begin
            S := HttpRest.ResponseRaw;
            if S = '' then S := HttpRest.LastResponse;
            if FLastError = '' then
                FLastError := HttpRest.LastResponse
            else begin
                if Assigned(HttpRest.ResponseJson) then begin
                    ErrJson := HttpRest.ResponseJson.O['errors'];
                    if Assigned(ErrJson) and (ErrJson.AsArray.Length > 0) then
                        S := ErrJson.AsArray.O[0].S['message'];
                end;
            end;
            SetError(OAuthErrBadGrant, 'Token Exchange Failed: ' + S);
            Exit;
        end
        else begin    // note getting request tokens not access tokens despite the labels!
          // this request does not return Json for some strange reason
            IcsExtractURLEncodedValue (HttpRest.ResponseRaw, 'oauth_token', FAccToken) ;
            IcsExtractURLEncodedValue (HttpRest.ResponseRaw, 'oauth_token_secret', FAccTokSecret) ;
        end;
        if (FAccToken = '') or (FAccTokSecret = '') then begin
            SetError(OAuthErrParams, 'Can Not Find OAuth1 Access Token in Response: ' + HttpRest.ResponseRaw);
            exit;
        end;
        Result := True;
        FExpireDT := Now + 710;  // 2 years
        FRefreshDT := 0;
        LogEvent('Got New Access Token: ' + FAccToken + ', No Expiry, No Refresh');
         if Assigned(FOnOAuthNewToken) then
             FOnOAuthNewToken(Self);
    end
    else begin
        HttpRest.RestParams.Clear;
        HttpRest.RestParams.PContent := PContUrlencoded;
     { note don't URL encode dynamic OAuth stuff }
        HttpRest.RestParams.AddItem('grant_type', 'authorization_code', True);         { V8.71 don't encode _ }
        HttpRest.RestParams.AddItem('code', FAuthCode, True);
        HttpRest.RestParams.AddItem('redirect_uri', FRedirectUrl);
        HttpRest.RestParams.AddItem('client_id', FClientId, True);
        HttpRest.RestParams.AddItem('client_secret', FClientSecret, True);
        if (NOT (OAopAuthNoScope in FOAOptions)) and (FScope <> '') then
            HttpRest.RestParams.AddItem('scope', FScope);
        Result := GetToken;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TRestOAuth.GrantRefresh: boolean;
begin
    Result := false;
    if (FRefreshToken = '') then begin
        SetError(OAuthErrParams, 'Can Not Start Authorization, Missing Refresh Token');
        Exit;
    end;
    if (FClientId = '') or (FClientSecret = '') then begin
        SetError(OAuthErrParams, 'Can Not Start Authorization, Need Client ID and Secret');
        Exit;
    end;
    HttpRest.RestParams.Clear;
    HttpRest.RestParams.PContent := PContUrlencoded;
     { note don't URL encode dynamic OAuth stuff }
    HttpRest.RestParams.AddItem('grant_type', 'refresh_token', True);         { V8.71 don't encode _ }
    HttpRest.RestParams.AddItem('refresh_token', FRefreshToken, true);
    LogEvent('Redirect URL: ' + FRedirectUrl);                { V8.70 tell user }
    HttpRest.RestParams.AddItem('redirect_uri', FRedirectUrl);
    HttpRest.RestParams.AddItem('client_id', FClientId, True);
    HttpRest.RestParams.AddItem('client_secret', FClientSecret, true);
    Result := GetToken;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TRestOAuth.GrantPasswordToken(const User, Pass: String): boolean;
begin
    Result := false;
    if (User = '') or (Pass = '') then begin
        SetError(OAuthErrParams, 'Can Not Start Authorization, Missing Username or Password');
        Exit;
    end;
    if (FClientId = '') or (FClientSecret = '') then begin
        SetError(OAuthErrParams, 'Can Not Start Authorization, Need Client ID and Secret');
        Exit;
    end;
    HttpRest.RestParams.Clear;
    HttpRest.RestParams.PContent := PContUrlencoded;
     { note don't URL encode dynamic OAuth stuff }
    HttpRest.RestParams.AddItem('grant_type', 'password', True);         { V8.71 don't encode _ }
    HttpRest.RestParams.AddItem('username', User);
    HttpRest.RestParams.AddItem('password', Pass);
    HttpRest.RestParams.AddItem('client_id', FClientId, True);
    HttpRest.RestParams.AddItem('client_secret', FClientSecret, true);
    if (NOT (OAopAuthNoScope in FOAOptions)) and (FScope <> '') then
        HttpRest.RestParams.AddItem('scope', FScope);
    Result := GetToken;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TRestOAuth.GrantAppToken: boolean;
begin
    Result := false;
    if (FClientId = '') or (FClientSecret = '') then begin
        SetError(OAuthErrParams, 'Can Not Start Authorization, Need Client ID and Secret');
        Exit;
    end;
    HttpRest.RestParams.Clear;
    HttpRest.RestParams.PContent := PContUrlencoded;
     { note don't URL encode dynamic OAuth stuff }
    HttpRest.RestParams.AddItem('grant_type', 'client_credentials', True);    { V8.71 don't encode _ }
    HttpRest.RestParams.AddItem('client_id', FClientId, True);
    HttpRest.RestParams.AddItem('client_secret', FClientSecret, true);
    if (NOT (OAopAuthNoScope in FOAOptions)) and (FScope <> '') then
        HttpRest.RestParams.AddItem('scope', FScope, False);
    Result := GetToken;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRestOAuth.FormLogEvent(const Line: String);                 { V8.71 }
begin
    LogEvent(Line);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRestOAuth.FormRedirEvent(const NewUrl: String; var HtmlBody: String; var CanClose: Boolean);      { V8.71 }
var
    Params, RespCode: String;
    I: Integer;
begin
    if Pos(FRedirectUrl, NewUrl) <> 1 then Exit;
    I := Pos('?', NewUrl);
    if I = 0 then Exit;

// found our redirection URL, get parameters
    LogEvent('OAuth Embedded Browser, Checkng for Authorization Code');
    Params := Copy(NewUrl, I + 1, MaxInt);
    WebSrvReq(Self, '', '', Params, RespCode, HtmlBody);
    if FAccToken <> '' then begin
        CanClose := True;
        LogEvent('OAuth Embedded Browser, App Token Generated Successfully');
    end
    else
        LogEvent('OAuth Embedded Browser, No App Token');
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ V8.65 TIcsTwitter to send and receive tweets }
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor TIcsTwitter.Create (Aowner: TComponent);
begin
    inherited Create(AOwner);
    HttpRest := TSslHttpRest.Create(self);
    HttpRest.OnHttpRestProg := TwitRestProg;
    HttpRest.RestParams.PContent := PContUrlencoded;
    HttpRest.RestParams.RfcStrict := True;
    FDebugLevel := DebugNone;
    FRestOAuth := TRestOAuth.Create(self);
    FRestOAuth.OnOAuthProg := TwitRestProg;
    FRestOAuth.OnOAuthNewToken := TwitNewToken;
    FRestOAuth.ProtoType := OAuthv1A;
    FRestOAuth.LoadAuthUri(OAuthUriTwitterOA1);
    FBaseURL := 'https://api.twitter.com/1.1/';
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor TIcsTwitter.Destroy;
begin
    FreeAndNil(FRestOAuth);
    FreeAndNil(HttpRest);
    inherited Destroy;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TIcsTwitter.TwitRestProg(Sender: TObject; LogOption: TLogOption; const Msg: string);
begin
    if Assigned(FOnTwitProg) then
        FOnTwitProg(Self, LogOption, Msg) ;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TIcsTwitter.TwitNewToken(Sender: TObject);
begin
    FAccToken := FRestOAuth.AccToken;
    FAccTokSecret := FRestOAuth.AccTokSecret;
    IcsExtractURLEncodedValue (FRestOAuth.HttpRest.ResponseRaw, 'user_id', FAccUserId) ;
    IcsExtractURLEncodedValue (FRestOAuth.HttpRest.ResponseRaw, 'screen_name', FAccScreenName) ;
    if Assigned(FOnTwitNewToken) then
        FOnTwitNewToken(Self) ;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TIcsTwitter.StartAuthorization: boolean;
begin
    Result := False;
    FLastError := '';
    if (FConApiKey = '') or (FConApiSecret= '') then begin
        FLastError := 'Can Not Login, Need Consumer API Key and Secret';
        Exit;
    end;
    FRestOAuth.DebugLevel := FDebugLevel;
    FRestOAuth.FClientId := FConApiKey;
    FRestOAuth.FClientSecret := FConApiSecret;
    if FForceLogin then
       FRestOAuth.OAOptions := [OAopAuthPrompt]
    else
        FRestOAuth.OAOptions := [];
//    FRestOAuth.FAppUrl := 'https://api.twitter.com/oauth/authorize';   // always shows window
    FRestOAuth.AppUrl := 'https://api.twitter.com/oauth/authenticate';   // logged in user skips window
    Result := FRestOAuth.StartAuthorization;
    if Result then begin
       // need to wait for browser callback which triggers TwitNewToken event
    end
    else
        FLastError := FRestOAuth.LastError;
    FResponseRaw := FRestOAuth.HttpRest.ResponseRaw;
    FResponseJson := FRestOAuth.HttpRest.ResponseJson;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TIcsTwitter.CommonSettings: boolean;
begin
    Result := False;
    FLastError := '';
    if (FConApiKey = '') or (FConApiSecret = '') then begin
        FLastError := 'Can Not Send Tweet, Need Consumer API Key and Secret';
        Exit;
    end;
    if (FAccToken = '') or (FAccTokSecret = '') then begin
        FLastError := 'Can Not Send Tweet, Must Login First to get Access Token and Secret';
        Exit;
    end;
    HttpRest.DebugLevel := FDebugLevel;
    FRestOAuth.DebugLevel := FDebugLevel;
    FRestOAuth.FClientId := FConApiKey;
    FRestOAuth.FClientSecret := FConApiSecret;
    FRestOAuth.AccToken := FAccToken;
    FRestOAuth.AccTokSecret := FAccTokSecret;
    FRestOAuth.AuthType := FOAAuthType;           { V8.71 }
    FRestOAuth.EdgeCacheDir := FOAEdgeCacheDir;   { V8.71 }
    FRestOAuth.OnOAuthEmbed := FOnTwitEmbed;      { V8.71 }
    Result := True;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Notes for adding new Twitter APIs
Each Twitter GET or POST request must be OAuth1A signed, with the hash signature
generated from a string that includes several fixed OAuth1A parameters and the
full URL of the request including query parameters, and the POST content.
The OAuth1A parameters and hash signature are then added as a header:
Authorization: OAuth oauth_consumer_key="xx", oauth_nonce="xx", oauth_signature="xx" etc

In the functions below, OAuthParams are built twice, once for the signbase
which includes request type, URL and request parameters, the has signature is
built by GetOAuthSignature, the Authorization bearer is built by adding
the new signature and removing the request paramaters, finally the request
parameters are added to RestParams and the URL to make the real REST request.

There is surely a better way to do this that avoids duplicating a lot of code
below, but it works...
}
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TIcsTwitter.SendTweet(const Msg: String): boolean;
var
    TwitURL, Signature, UrlParam, Msg2: String;
    ErrJson, UserJson: ISuperObject;
    StatCode: Integer;
begin
    Result := False;
    if NOT CommonSettings then Exit;
    TwitURL := FBaseURL + 'statuses/update.json';
    UrlParam := '?include_entities=false';   // change below as well!
    Msg2 := Trim(Msg);

// build base string, used for hashed signature
// must include POST content and URL paramaters, sorted
    FRestOAuth.OAuthParams.Clear;
    FRestOAuth.OAuthParams.AddItem('status', Msg2);
    FRestOAuth.OAuthParams.AddItem('include_entities', False);
    Signature := FRestOAuth.GetOAuthSignature('POST', TwitURL, False);   // adds OAuth1 parameters

// adjust base string for Authorization: OAuth header, add signature, remove parameters
    FRestOAuth.OAuthParams.RemoveItem('status');
    FRestOAuth.OAuthParams.RemoveItem('include_entities');
    FRestOAuth.OAuthParams.AddItem('oauth_signature', Signature);
    HttpRest.ServerAuth := httpAuthOAuth;
    FRestOAuth.OAuthParams.PContent := PContCommaList;  // change paramter format
    HttpRest.AuthBearerToken := String(FRestOAuth.OAuthParams.GetParameters(True)); // bearer is quoted encoded values, comma separated
    TwitRestProg(Self, loProtSpecInfo, 'Authorization: OAuth ' + HttpRest.AuthBearerToken);

 // now build POST content and URL with parameters
    HttpRest.RestParams.Clear;
    HttpRest.RestParams.AddItem('status', Msg2);
    TwitURL := TwitURL + UrlParam;
    StatCode := HttpRest.RestRequest(httpPOST, TwitURL, False, '');
    if FDebugLevel < DebugBody then  // not already logging it
        TwitRestProg(Self, loProtSpecInfo, String(HttpRest.ResponseRaw));
    if (StatCode <> 200) then begin
        FLastError := HttpRest.ResponseRaw;
        if FLastError = '' then
            FLastError := HttpRest.LastResponse
        else begin
            if Assigned(HttpRest.ResponseJson) then begin
                ErrJson := HttpRest.ResponseJson.O['errors'];
                if Assigned(ErrJson) and (ErrJson.AsArray.Length > 0) then
                    FLastError := ErrJson.AsArray.O[0].S['message'];
            end;
        end;
    end
    else begin
        Result := True;
        FLastTweetId := HttpRest.ResponseJson.S['id'];
        UserJson := HttpRest.ResponseJson.O['user'];
        FAccScreenName := UserJson.S['screen_name'];
        FAccUserId := UserJson.S['id'];
    end;
    HttpRest.Close;
    FResponseRaw := HttpRest.ResponseRaw;
    FResponseJson := HttpRest.ResponseJson;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TIcsTwitter.GetAccSett: boolean;
var
    TwitURL, Signature: String;
    StatCode: Integer;
    ErrJson: ISuperObject;
begin
    Result := False;
    if NOT CommonSettings then Exit;
    TwitURL := FBaseURL + 'account/settings.json';
// build base string, used for hashed signature
// must include POST content and URL paramaters, sorted
    FRestOAuth.OAuthParams.Clear;
    Signature := FRestOAuth.GetOAuthSignature('GET', TwitURL, False);   // adds OAuth1 parameters

// adjust base string for Authorization: OAuth header, add signature
    FRestOAuth.OAuthParams.AddItem('oauth_signature', Signature);
    HttpRest.ServerAuth := httpAuthOAuth;
    FRestOAuth.OAuthParams.PContent := PContCommaList;  // change paramter format
    HttpRest.AuthBearerToken := String(FRestOAuth.OAuthParams.GetParameters(True)); // bearer is quoted encoded values, comma separated
    TwitRestProg(Self, loProtSpecInfo, 'Authorization: OAuth ' + HttpRest.AuthBearerToken);

 // now build POST content and URL
    HttpRest.RestParams.Clear;
    StatCode := HttpRest.RestRequest(httpGET, TwitURL, False, '');
    if FDebugLevel < DebugBody then  // not already logging it
        TwitRestProg(Self, loProtSpecInfo, String(HttpRest.ResponseRaw));
    if (StatCode <> 200) then begin
        FLastError := HttpRest.ResponseRaw;
        if FLastError = '' then
            FLastError := HttpRest.LastResponse
        else begin
            if Assigned(HttpRest.ResponseJson) then begin
                ErrJson := HttpRest.ResponseJson.O['errors'];
                if Assigned(ErrJson) and (ErrJson.AsArray.Length > 0) then
                    FLastError := ErrJson.AsArray.O[0].S['message'];
            end;
        end;
    end
    else begin
        Result := True;
    end;
    FResponseRaw := HttpRest.ResponseRaw;
    FResponseJson := HttpRest.ResponseJson;
 end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TIcsTwitter.SearchTweets(const Query: String): boolean;
var
    TwitURL, Signature: String;
    StatCode: Integer;
    ErrJson: ISuperObject;
begin
    Result := False;
    if NOT CommonSettings then Exit;
    TwitURL := FBaseURL + 'search/tweets.json';

// build base string, used for hashed signature
// must include POST content and URL paramaters, sorted
    FRestOAuth.OAuthParams.Clear;
    FRestOAuth.OAuthParams.AddItem('q', Query);
    FRestOAuth.OAuthParams.AddItem('count', 50);
    Signature := FRestOAuth.GetOAuthSignature('GET', TwitURL, False);   // adds OAuth1 parameters

// adjust base string for Authorization: OAuth header, add signature, remove parameters
    FRestOAuth.OAuthParams.RemoveItem('q');
    FRestOAuth.OAuthParams.RemoveItem('count');
    FRestOAuth.OAuthParams.AddItem('oauth_signature', Signature);
    HttpRest.ServerAuth := httpAuthOAuth;
    FRestOAuth.OAuthParams.PContent := PContCommaList;  // change paramter format
    HttpRest.AuthBearerToken := String(FRestOAuth.OAuthParams.GetParameters(True)); // bearer is quoted encoded values, comma separated
    TwitRestProg(Self, loProtSpecInfo, 'Authorization: OAuth ' + HttpRest.AuthBearerToken);

 // now build POST content and URL with parameters
    HttpRest.RestParams.Clear;
    HttpRest.RestParams.AddItem('q', Query);
    HttpRest.RestParams.AddItem('count', 50);
    StatCode := HttpRest.RestRequest(httpGET, TwitURL, False, '');
    if FDebugLevel < DebugBody then  // not already logging it
        TwitRestProg(Self, loProtSpecInfo, String(HttpRest.ResponseRaw));
    if (StatCode <> 200) then begin
        FLastError := HttpRest.ResponseRaw;
        if FLastError = '' then
            FLastError := HttpRest.LastResponse
        else begin
            if Assigned(HttpRest.ResponseJson) then begin
                ErrJson := HttpRest.ResponseJson.O['errors'];
                if Assigned(ErrJson) and (ErrJson.AsArray.Length > 0) then
                    FLastError := ErrJson.AsArray.O[0].S['message'];
            end;
        end;
    end
    else begin
        Result := True;
    end;
    FResponseRaw := HttpRest.ResponseRaw;
    FResponseJson := HttpRest.ResponseJson;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

{ NOTE: ListTweets and SearchTweets seem to give an "Could not authenticate you."
  error if called immediately after SendTweet, no idea why, the signature seems OK.  }

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TIcsTwitter.ListTweets(const IdList: String): boolean;
var
    TwitURL, Signature: String;
    ErrJson: ISuperObject;
    StatCode: Integer;
begin
    Result := False;
    if NOT CommonSettings then Exit;
    TwitURL := FBaseURL + 'statuses/lookup.json';

// build base string, used for hashed signature
// must include POST content and URL paramaters, sorted
    FRestOAuth.OAuthParams.Clear;
    FRestOAuth.OAuthParams.AddItem('id', IdList);
    Signature := FRestOAuth.GetOAuthSignature('GET', TwitURL, False);   // adds OAuth1 parameters

// adjust base string for Authorization: OAuth header, add signature, remove parameters
    FRestOAuth.OAuthParams.RemoveItem('id');
    FRestOAuth.OAuthParams.AddItem('oauth_signature', Signature);
    HttpRest.ServerAuth := httpAuthOAuth;
    FRestOAuth.OAuthParams.PContent := PContCommaList;  // change paramter format
    HttpRest.AuthBearerToken := String(FRestOAuth.OAuthParams.GetParameters(True)); // bearer is quoted encoded values, comma separated
    TwitRestProg(Self, loProtSpecErr, 'Authorization: OAuth ' + HttpRest.AuthBearerToken);

 // now build POST content and URL with parameters
    HttpRest.RestParams.Clear;
    HttpRest.RestParams.AddItem('id', IdList);
    StatCode := HttpRest.RestRequest(httpGET, TwitURL, False, '');
    if FDebugLevel < DebugBody then  // not already logging it
        TwitRestProg(Self, loProtSpecInfo, String(HttpRest.ResponseRaw));
    if (StatCode <> 200) then begin
        FLastError := HttpRest.ResponseRaw;
        if FLastError = '' then
            FLastError := HttpRest.LastResponse
         else begin
            if Assigned(HttpRest.ResponseJson) then begin
                ErrJson := HttpRest.ResponseJson.O['errors'];
                if Assigned(ErrJson) and (ErrJson.AsArray.Length > 0) then
                    FLastError := ErrJson.AsArray.O[0].S['message'];
            end;
         end;
    end
    else begin
        Result := True;
    end;
    FResponseRaw := HttpRest.ResponseRaw;
    FResponseJson := HttpRest.ResponseJson;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
constructor TIcsRestEmail.Create (Aowner: TComponent);
begin
    inherited Create(AOwner);
    HttpRest := TSslHttpRest.Create(self);
    HttpRest.OnHttpRestProg := EmailRestProg;
    HttpRest.RestParams.PContent := PContUrlencoded;
    HttpRest.RestParams.RfcStrict := True;
    FDebugLevel := DebugNone;
    FRestOAuth := TRestOAuth.Create(self);
    FRestOAuth.OnOAuthProg := EmailRestProg;
    FRestOAuth.OnOAuthNewToken := EmailNewToken;
    FRestOAuth.ProtoType := OAuthv2;
    FOAAuthType := FRestOAuth.AuthType;   { V8.66 }
    FMsUserAuth := FRestOAuth.MsUserAuthority;  { V8.70 }
    FRestEmailType := RestEmailGoogle;
    FLoginTimeout := 120;                 { V8.66 was 30, but need to get past several web pages }
    FWaitSecs := 0;
    FHdrFieldList := 'to,from,subject,date';
    FCancelFlag := False;
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
destructor TIcsRestEmail.Destroy;
begin
    try
        FreeAndNil(FRestOAuth);
        FreeAndNil(HttpRest);
    finally
        inherited Destroy;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TIcsRestEmail.Clear;
begin
    FNewAccEmail := '';
    FNewAccName := '';
    FAccToken := '';
    FAccExpireDT := 0;
    FLastError := '';
    FLastErrCode := 0;
    FNewAccScope := '';
    FTokenType := '';
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TIcsRestEmail.EmailRestProg(Sender: TObject; LogOption: TLogOption; const Msg: string);
begin
    if Assigned(FOnEmailProg) then
        FOnEmailProg(Self, LogOption, Msg) ;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TIcsRestEmail.EmailNewToken(Sender: TObject);
begin
    FRestOAuth.StopSrv(False);  { V8.65 close server but not current client }
    FNewAccEmail := '';
    FNewAccName := '';
    FAccToken := FRestOAuth.AccToken;
    FAccExpireDT := FRestOAuth.ExpireDT;
    if FRestOAuth.RefreshToken <> '' then  { google only supplies refresh once }
        FRefrToken := FRestOAuth.RefreshToken;
    IcsExtractURLEncodedValue (FRestOAuth.HttpRest.ResponseRaw, 'scope', FNewAccScope) ;
    IcsExtractURLEncodedValue (FRestOAuth.HttpRest.ResponseRaw, 'token_type', FTokenType) ;

// get profile for email address to find out what account we logged into
    GetProfile;
    if FTokenType <> '' then
        EmailRestProg(Self, loDestEvent, 'Token Type: ' + FTokenType + ', Scope: ' + FNewAccScope);   { V8.69 }

 // tell user we got something
    if Assigned(FOnEmailNewToken) then
        FOnEmailNewToken(Self) ;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TIcsRestEmail.CommonSettings: boolean;
begin
    Result := False;
    FLastError := '';
    if (FCliID = '') or (FCliSecret = '') then begin
        FLastError := 'Can Not Send Email, Need Application Client ID and Secret';
        Exit;
    end;
    HttpRest.ServerAuth := httpAuthBearer;
    HttpRest.AuthBearerToken := FAccToken;
    HttpRest.DebugLevel := FDebugLevel;
    HttpRest.RestParams.PContent := PContUrlencoded;
    HttpRest.RestParams.Clear;
    FRestOAuth.DebugLevel := FDebugLevel;
    FRestOAuth.OAOptions := [OAopAuthAccess];

// set-up common URLs and local web server details for common providers
    if FRestEmailType = RestEmailGoogle then begin
        FRestOAuth.LoadAuthUri(OAuthUriGoogle);
        FBaseURL := 'https://www.googleapis.com/gmail/v1/users/';
        FRestOAuth.OAOptions := FRestOAuth.OAOptions + [OAopAuthGrantedScope];
    end
    else if FRestEmailType = RestEmailMSRest then begin
        FRestOAuth.LoadAuthUri(OAuthUriMSRest);
        FBaseURL := 'https://graph.microsoft.com/v1.0/';
        FRestOAuth.ResponseMode := 'query';
        FRestOAuth.OAOptions := FRestOAuth.OAOptions + [OAopAuthRespMode, OAopAuthLoginHint];
    end
    else if FRestEmailType = RestEmailMSSmtp then begin
        FRestOAuth.LoadAuthUri(OAuthUriMSSmtp);
        FBaseURL := 'https://graph.microsoft.com/v1.0/';
        FRestOAuth.ResponseMode := 'query';
        FRestOAuth.OAOptions := FRestOAuth.OAOptions + [OAopAuthRespMode, OAopAuthLoginHint];
    end
    else begin
        FLastError := 'Unsupported Email Provider';
        Exit;
    end;

// load information needed to access OAuth2 authentication, may expires after a year or more
    FRestOAuth.ClientId := FCliID;
    FRestOAuth.ClientSecret := FCliSecret;
    FRestOAuth.RefreshOffline := True;     // need for offline to get refresh token
    FRestOAuth.MsUserAuthority := FMsUserAuth;              { V8.70 }
    FRestOAuth.AuthType := FOAAuthType;                     { V8.66 }
    FRestOAuth.EdgeCacheDir := FOAEdgeCacheDir;             { V8.71 }
    FRestOAuth.LoginHint := FAccountHint;                   { V8.71 all types, displayed in window }
    FRestOAuth.OnOAuthEmbed := FOnOAEmbed;                  { V8.71 }

// dynamic stuff returned by OAuth2, if saved avoids getting it again
    FRestOAuth.AccToken := FAccToken;
    FRestOAuth.ExpireDT := FAccExpireDT;      // for access token, usually less than one day
    FRestOAuth.RefreshToken := FRefrToken;    // usually expires after several months
    Result := True;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TIcsRestEmail.SetOAuthErrs;               { V8.66 }
begin
    FLastErrCode := FRestOAuth.LastErrCode;
    FLastError := FRestOAuth.LastError;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TIcsRestEmail.TestRedirect: boolean;
begin
    Result := False;
    if NOT CommonSettings then Exit;
    Result := FRestOAuth.TestRedirect;
    if NOT Result then SetOAuthErrs;              { V8.66 }
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TIcsRestEmail.LaunchConsole: boolean;
begin
    Result := False;
    if NOT CommonSettings then Exit;
    Result := FRestOAuth.LaunchConsole;
    if NOT Result then SetOAuthErrs;              { V8.66 }
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TIcsRestEmail.StartAuthorization: boolean;
begin
    Result := False;
    Clear;
    if NOT CommonSettings then Exit;
    if FForceLogin then begin
        FRestOAuth.LoginPrompt := 'select_account';
        FRestOAuth.OAOptions := FRestOAuth.OAOptions + [OAopAuthPrompt];
    end;
    Result := FRestOAuth.StartAuthorization;
    if NOT Result then SetOAuthErrs;              { V8.66 }
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TIcsRestEmail.UpdateToken: Boolean;
begin
    Result := False;
    if NOT CommonSettings then Exit;
    Result := FRestOAuth.GrantRefresh;
    if NOT Result then SetOAuthErrs;              { V8.66 }
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ this function should be called SMTP and POP3 clients needing an OAuth2
  bearer token, it should return quickly if a refresh token is available
  but if not will need to launch a browser windows for the user to login,
  it will wait LoginTimeout seconds for this to happen before failing,
  or will fail immediately is Interactive is false, for servers.
  V8.66 servers may also set OAAuthType=OAuthTypeMan and an event from
  which to call the browser URL perhaps via email }
function TIcsRestEmail.GetNewToken(Interactive: Boolean = False): Boolean;    { V8.71 }
var
    TimeoutTrg: Int64;      { V8.71 }
begin
    Result := False;
    FWaitSecs := 0;
    FCancelFlag := False;
    try       { V8.66 }
        if (FAccToken = '') or (FAccExpireDT < Now) then begin
            if (FRefrToken <> '') then
                Result := UpdateToken;
            if NOT Result then begin
                if NOT Interactive then
                    Exit;
                FRestOAuth.AuthType := FOAAuthType;                           { V8.66 }
                FRestOAuth.EdgeCacheDir := FOAEdgeCacheDir;                   { V8.71 }
                FRestOAuth.OnOAuthAuthUrl := FOnOAAuthUrl;                    { V8.66 }
                Result := StartAuthorization;
                if NOT Result then
                    Exit;
                if FRestOAuth.LastErrCode = OAuthErrCancelled then Exit;      { V8.71 }

              // need to wait for the user to fill in the login using a brower windows
              // token might already have been collected via Embedded Browser
                if FLoginTimeout < 5 then
                    FLoginTimeout := 60;
                TimeoutTrg := IcsGetTrgSecs64 (FLoginTimeout);                { V8.71 }
                while (FAccToken = '') do begin
                    HttpRest.CtrlSocket.ProcessMessages ;
                    if HttpRest.CtrlSocket.Terminated then break ;
                    if IcsTestTrgTick64(TimeoutTrg) then break;
                    if FCancelFlag then break;
                    FWaitSecs := (IcsDiffSecs64(IcsGetTickCount64, TimeoutTrg));       { V8.71 }
                end;
                Result := (FAccToken <> '');
            end;
        end
        else
            Result := True; // nothing to do, got an unexpired token
    finally
        FWaitSecs := 0;
        if FRestOAuth.SrvIsRunning then FRestOAuth.StopSrv;
        FRestOAuth.Close;
        if HttpRest.State = httpConnected then HttpRest.Close;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TIcsRestEmail.CancelWait;
begin
    FCancelFlag := True;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ common get error handler }
procedure TIcsRestEmail.SetRestError;
var
    ErrJson: ISuperObject;
begin
    FLastError := HttpRest.ResponseRaw;
    if FLastError = '' then
        FLastError := HttpRest.LastResponse
    else begin
        if Assigned(HttpRest.ResponseJson) then begin
            ErrJson := HttpRest.ResponseJson.O['errors'];
            if Assigned(ErrJson) and (ErrJson.AsArray.Length > 0) then
                FLastError := ErrJson.AsArray.O[0].S['message']
            else begin
                ErrJson := HttpRest.ResponseJson.O['error'];
                if Assigned(ErrJson) then
                    FLastError := ErrJson.S['message'];
            end;
        end;
    end;
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ get information about who is logged-on, which we may not know due to
  OAuth2 authentification, primarily the email address, but it may not
  have an email account associated }
function TIcsRestEmail.GetProfile: boolean;
var
    EmailURL: String;
    StatCode: Integer;
begin
    Result := False;
    if NOT CommonSettings then Exit;
    if FRestEmailType = RestEmailGoogle then
        EmailURL := FBaseURL + 'me/profile'
    else if (FRestEmailType = RestEmailMSRest) or
                             (FRestEmailType = RestEmailMSSmtp) then
        EmailURL := FBaseURL + 'me/'
    else
        Exit;
    StatCode := HttpRest.RestRequest(httpGET, EmailURL, False, '');
    if (StatCode <> 200) then
        SetRestError
    else begin
        if Assigned(HttpRest.ResponseJson) then begin
            Result := True;
            FNewAccEmail := HttpRest.ResponseJson.S['emailAddress'];  // Google
            if FNewAccEmail = '' then begin
                FNewAccEmail := HttpRest.ResponseJson.S['mail'];      // Microsoft
                if FNewAccEmail = 'null' then FNewAccEmail := '';
            end;
            if FNewAccEmail = '' then
                FNewAccEmail := HttpRest.ResponseJson.S['userPrincipalName'];  // Microsoft
            FNewAccName := HttpRest.ResponseJson.S['displayName'];             // Microsoft
        end;
    end;
    FResponseRaw := HttpRest.ResponseRaw;
    FResponseJson := HttpRest.ResponseJson;
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ Google get list of email IDs, no headers or anything, currently just the first MaxNr }
{ Microsoft Outlook, also returns headera }
function TIcsRestEmail.ListEmails(const Query: String = '';
                    const MBLabels: String = 'INBOX'; MaxNr: Integer = 100): boolean;
var
    EmailURL: String;
    StatCode: Integer;
begin
    Result := False;
    if NOT CommonSettings then Exit;
    if FRestEmailType = RestEmailGoogle then begin
        HttpRest.RestParams.AddItem('maxResults', MaxNr);
        HttpRest.RestParams.AddItem('includeSpamTrash', True);
        if Query <> '' then
            HttpRest.RestParams.AddItem('q', Query);
        if MBLabels <> '' then
            HttpRest.RestParams.AddItem('labelIds', MBLabels, RPTypeArray);
         HttpRest.RestParams.AddItem('includeSpamTrash', False);
         EmailURL := FBaseURL + 'me/messages'
    end
    else if FRestEmailType = RestEmailMSRest then begin
        HttpRest.RestParams.AddItem('$top', MaxNr);
        HttpRest.RestParams.AddItem('$count', True);
        HttpRest.RestParams.AddItem('$format', 'json');
        HttpRest.RestParams.AddItem('$select', FHdrFieldList);
        if Query <> '' then
            HttpRest.RestParams.AddItem('$filter', Query);
        if MBLabels = '' then
            EmailURL := FBaseURL + 'me/messages'
         else
            EmailURL := FBaseURL + 'me/mailFolders/' + MBLabels + '/messages'
    end
    else
        Exit;
    StatCode := HttpRest.RestRequest(httpGET, EmailURL, False, '');
    if (StatCode <> 200) then
        SetRestError
    else begin
        if Assigned(HttpRest.ResponseJson) then begin
             Result := True;
         end;
    end;
    FResponseRaw := HttpRest.ResponseRaw;
    FResponseJson := HttpRest.ResponseJson;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TIcsRestEmail.GetEmail(const Id: String; EmailFmt: TRestEmailFmt = EmailFmtHdr): boolean;
var
    EmailURL, FmtLit: String;
    StatCode: Integer;
begin
    Result := False;
    if NOT CommonSettings then Exit;
    if FRestEmailType = RestEmailGoogle then begin
        if EmailFmt = EmailFmtRaw then
            FmtLit := 'raw'
        else if EmailFmt = EmailFmtFull then
            FmtLit := 'full'
        else
            FmtLit := 'metadata';
        HttpRest.RestParams.AddItem('format', FmtLit);
        if (EmailFmt = EmailFmtHdr) and (FHdrFieldList <> '') then
            HttpRest.RestParams.AddItem('metadataHeaders', FHdrFieldList, RPTypeArray);
        EmailURL := FBaseURL + 'me/messages/' + Id;
    end
    else if FRestEmailType = RestEmailMSRest then begin
        HttpRest.RestParams.AddItem('$select', FHdrFieldList);
        EmailURL := FBaseURL + 'me/messages/' + Id;
    end
    else
        Exit;
    StatCode := HttpRest.RestRequest(httpGET, EmailURL, False, '');
    if (StatCode <> 200) then
        SetRestError
    else begin
        if Assigned(HttpRest.ResponseJson) then
            Result := True;
    end;
    FResponseRaw := HttpRest.ResponseRaw;
    FResponseJson := HttpRest.ResponseJson;
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TIcsRestEmail.SendEmail(const Content: String): boolean;
var
    EmailURL: String;
    StatCode: Integer;
begin
    Result := False;
    if NOT CommonSettings then Exit;

  // Gmail needs an RFC822 raw email prepared by the SMTP client component
    if FRestEmailType = RestEmailGoogle then begin
        HttpRest.RestParams.AddItem('raw', IcsBase64UrlEncode(Content));
        HttpRest.RestParams.PContent := PContBodyJson;
        EmailURL := FBaseURL + 'me/messages/send';
    end

  // Microsoft Outlook sends message as Json
    else if FRestEmailType = RestEmailMSRest then begin
        EmailURL := FBaseURL + 'me/sendMail';
        HttpRest.RestParams.AddItem('message', Content, True); // raw json
        HttpRest.RestParams.PContent := PContBodyJson;
    end
    else
        Exit;
    StatCode := HttpRest.RestRequest(httpPOST, EmailURL, False, '');
    if (StatCode = 202) then     // Microsoft Outlook does not return any Id
        Result := True
    else if (StatCode <> 200) then
        SetRestError
    else begin
        if Assigned(HttpRest.ResponseJson) then begin
            Result := True;
            FLastEmailId := HttpRest.ResponseJson.S['id'];
         end;
    end;
    FResponseRaw := HttpRest.ResponseRaw;
    FResponseJson := HttpRest.ResponseJson;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TIcsRestEmail.DeleteEmail(const Id: String): boolean;
var
    EmailURL: String;
    StatCode: Integer;
begin
    Result := False;
    FLastEmailId := '';
    if NOT CommonSettings then Exit;
    if FRestEmailType = RestEmailGoogle then begin
        EmailURL := FBaseURL + 'me/messages/' + Id;
    end
    else if FRestEmailType = RestEmailMSRest then begin
        EmailURL := FBaseURL + 'me/messages/' + Id;
    end
    else
        Exit;
    StatCode := HttpRest.RestRequest(httpDELETE, EmailURL, False, '');
    if (StatCode <> 204) then
        SetRestError
    else begin
         Result := True;  // no response for delete
    end;
    FResponseRaw := HttpRest.ResponseRaw;
    FResponseJson := HttpRest.ResponseJson;
end;



{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ default INI section
[RestEmail]
RestEmailType=RestEmailGoogle
ClientId=
ClientSecret=
RefrToken=
MsUserAuth=consumers }

function IcsLoadRestEmailFromIni(MyIniFile: TCustomIniFile; MyRestEmail:
                TIcsRestEmail; const Section: String = 'RestEmail'): Boolean;         { V8.70 }
begin
    if NOT Assigned (MyIniFile) then
        raise ESocketException.Create('Must open and assign INI file first');
    if NOT Assigned (MyRestEmail) then
        raise ESocketException.Create('Must assign IcsRestEmail first');

{ Warning - Ideally these settings should be encrypted!! }

    MyRestEmail.RestEmailType := TRestEmailType(GetEnumValue (TypeInfo (TRestEmailType),
                     IcsTrim(MyIniFile.ReadString(Section, 'RestEmailType', 'RestEmailGoogle'))));
    if MyRestEmail.RestEmailType > High(TRestEmailType) then
        MyRestEmail.RestEmailType := RestEmailGoogle;
    MyRestEmail.ClientId := MyIniFile.ReadString (section, 'ClientId', '');
    MyRestEmail.ClientSecret := MyIniFile.ReadString (section, 'ClientSecret', '');
    MyRestEmail.RefrToken := MyIniFile.ReadString (section, 'RefrToken', '');
    MyRestEmail.MsUserAuth := MyIniFile.ReadString (section, 'MsUserAuth', OAuthMsUserAuthDef);
    MyRestEmail.FOAEdgeCacheDir := MyIniFile.ReadString (section, 'OAEdgeCacheDir', '');           { V8.71 }
    Result := (MyRestEmail.ClientId <> '') and (MyRestEmail.ClientSecret <> '');
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

{$ENDIF USE_SSL}

end.
